The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-

use strict;
use Set::IntSpan 1.13;

my $N = 1;
sub Not { print "not " }
sub OK  { print "ok ", $N++, "\n" }

sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) }

my $Err = "Set::IntSpan::elements: infinite set";

my @New = 
([''              , '-'      , ''             ,  []		     ],
 ['     '         , '-'      , ''             ,  []		     ],
 [' ( - )  '      , '(-)'    , $Err           ,  [[undef, undef]]    ],
 ['-_2 -     -1  ', '-2--1'  , '-2,-1'        ,  [[-2,-1]]	     ],
 ['-'             , '-'      , ''             ,  []		     ],
 ['0'             , '0'      , '0'            ,	 [[0,0]]	     ],
 ['1'             , '1'      , '1'            ,  [[1,1]]	     ],
 ['1-1'           , '1'      , '1'            ,  [[1,1]]	     ],
 ['-1'            , '-1'     , '-1'           ,  [[-1,-1]]	     ],
 ['1-2'           , '1-2'    , '1,2'          ,  [[1,2]]	     ],
 ['-2--1'         , '-2--1'  , '-2,-1'        ,  [[-2,-1]]	     ],
 ['-2-1'          , '-2-1'   , '-2,-1,0,1'    ,  [[-2,1]]	     ],
 ['1,2-4'         , '1-4'    , '1,2,3,4'      ,  [[1,4]]	     ],
 ['1-3,4,5-7'     , '1-7'    , '1,2,3,4,5,6,7',	 [[1,7]]	     ],
 ['1-3,4'         , '1-4'    , '1,2,3,4'      ,  [[1,4]]	     ],
 ['1,2,4,5,6,7'   , '1-2,4-7', '1,2,4,5,6,7'  ,	 [[1,2],[4,7]]	     ],
 ['1,2-)'         , '1-)'    , $Err           ,  [[1,undef]]	     ],
 ['(-0,1-)'       , '(-)'    , $Err           ,  [[undef,undef]]     ],
 ['(-)'           , '(-)'    , $Err           ,  [[undef,undef]]     ],
 ['1-)'           , '1-)'    , $Err           ,  [[1,undef]]	     ],
 ['(-1'           , '(-1'    , $Err           ,  [[undef,1]]         ],
 ['-3,-1-)'       , '-3,-1-)', $Err           ,  [[-3,-3],[-1,undef]]],
 ['(-1,3'         , '(-1,3'  , $Err           ,  [[undef,1],[3,3]]   ],
);

my @New_list = 
(
 ['1', '2', '1-2'],
 ['1-5', '2', '1-5'],
 ['1-5', '2-8', '1-8'],
 ['1-5', '2-8', '10-20', '1-8,10-20'],
 ['(-5', '2-8', '10-20', '(-8,10-20'],
 ['(-5', '2-8', '10-)', '(-8,10-)'],
 ['40-45', '20-25', '10-15', '1', '12-13', '1,10-15,20-25,40-45' ]
);

my @New_array =
(
 [ [ 3, 2, 1                             ], "1-3"         ],
 [ [ [ undef, -1 ]                       ], "(--1"        ],
 [ [ 5, [ undef, 1 ], 3    		 ], "(-1,3,5" 	  ],
 [ [ 5, [ undef, 1 ], 3, 4 		 ], "(-1,3-5" 	  ],
 [ [ 5, [ undef, 1 ], 3, [ 8, undef ], 4 ], "(-1,3-5,8-)" ],
 [ [ 5, [ undef, 1 ], 3, [ 6, undef ], 4 ], "(-1,3-)"     ],
 [ [ 5, [ undef, 2 ], 3, [ 4, undef ], 4 ], "(-)"         ],
 [ [ [ 1, 5 ], [ 3, 8 ], 27              ], "1-8,27"      ],
 [ [ 1, [ 5, 8 ], 5, [ 7, 9 ], 2         ], "1-2,5-9"     ],

);

print "1..", @New * 7 + @New_list + @New_array, "\n";
New      ();
Elements ();
Sets     ();
Spans    ();
New_list ();
New_array();


sub New
{
    print "#new\n";

    for my $test (@New)
    {
        my $set    = new Set::IntSpan $test->[0];
	my $result = $set->run_list();
	printf "#new %-14s -> %s\n", $test->[0], $result;
	$result eq $test->[1] or Not; OK

	my $copy = new Set::IntSpan $set;
	$result = $copy->run_list();
	printf "#new %-14s -> %s\n", $test->[0], $result;
	$result eq $test->[1] or Not; OK;
    }
}


sub Elements
{
    print "#elements\n";

    my($set, $expected, @elements, $elements, $result);

    for my $t (@New)
    {
        $set      = new Set::IntSpan $t->[0];
	$expected = $t->[2];

	eval { @elements = elements $set };
	if ($@)
	{
	    printf "#elements %-14s -> %s\n", $t->[0], $@;
	    $@ =~/$expected/ or Not; OK;
	}
	else
	{
	    $result = join(',', @elements );
	    printf "#elements %-14s -> %s\n", $t->[0], $result;
	    $result eq $expected or Not; OK;
	}

	eval { $elements = elements $set };
	if ($@)
	{
	    printf "#elements %-14s -> %s\n", $t->[0], $@;
	    $@ =~ /$expected/ or Not; OK;
	}
	else
	{
	    $result = join(',', @$elements );
	    printf "#elements %-14s -> %s\n", $t->[0], $result;
	    $result eq $expected or Not; OK;
	}
    }
}

sub Sets
{
    print "#sets\n";

    for my $t (@New)
    {
	my $set      = new Set::IntSpan $t->[0];
	my @sets     = sets $set;
	my @expected = map { $_ eq '-' 
				 ? ()
				 : new Set::IntSpan $_ } split /,/, $t->[1];

	equal_sets(\@sets, \@expected) or Not; OK;
    }
}

sub equal_sets
{
    my($a, $b) = @_;

    @$a == @$b or return 0;

    while (@$a)
    {
	my $a = shift @$a;
	my $b = shift @$b;

	ref $a eq 'Set::IntSpan' or return 0;
	ref $b eq 'Set::IntSpan' or return 0;

	equal $a $b or return 0;
    }

    1
}

sub Spans
{
    print "#spans\n";

    for my $t (@New)
    {
	my $set1     = new Set::IntSpan $t->[0];
	my @spans    = spans $set1;
	my $expected = $t->[3];
	equal_lists(\@spans, $expected) or Not; OK;

	my $set2    = new Set::IntSpan $t->[3];
	equal $set1 $set2 or Not; OK;
	print "set1 $set1, set2 $set2\n";
	
    }
}

sub equal_lists
{
    my($a, $b) = @_;

    # print "a <@$a>, b <@$b>\n";
    @$a==@$b or return 0;

    my @a = @$a;
    my @b = @$b;

    while (@a)
    {
	my $aa = shift @a;
	my $bb = shift @b;

	if    (ref     $aa and ref     $bb) { equal_lists($aa, $bb) 		  or return 0 }
	elsif (defined $aa and defined $bb) { $aa == $bb	    		  or return 0 }
	else  				    { not defined $aa and not defined $bb or return 0 }
    }

    1
}


sub New_list
{
    for my $t (@New_list)
    {
	my @run_lists = @$t;
	my $expected = pop @run_lists;
	my $set = new Set::IntSpan @run_lists;
	my $actual = $set->run_list;
	$set->equal($expected) or Not; OK;
    }
}


sub New_array
{
    for my $t (@New_array)
    {
	my $actual = new Set::IntSpan $t->[0];
	my $expected = $t->[1];
	$actual eq $expected or Not; OK;
    }
}