# -*- 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; } }