1# -*- perl -*- 2 3use strict; 4use Set::IntSpan 1.17; 5 6my $N = 1; 7sub Not { print "not " } 8sub OK { print "ok ", $N++, "\n" } 9 10sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) } 11 12my $Err = "Set::IntSpan::elements: infinite set"; 13 14my @New = 15(['' , '-' , '' , [] ], 16 [' ' , '-' , '' , [] ], 17 [' ( - ) ' , '(-)' , $Err , [[undef, undef]] ], 18 ['-_2 - -1 ', '-2--1' , '-2,-1' , [[-2,-1]] ], 19 ['-' , '-' , '' , [] ], 20 ['0' , '0' , '0' , [[0,0]] ], 21 ['1' , '1' , '1' , [[1,1]] ], 22 ['1-1' , '1' , '1' , [[1,1]] ], 23 ['-1' , '-1' , '-1' , [[-1,-1]] ], 24 ['1-2' , '1-2' , '1,2' , [[1,2]] ], 25 ['-2--1' , '-2--1' , '-2,-1' , [[-2,-1]] ], 26 ['-2-1' , '-2-1' , '-2,-1,0,1' , [[-2,1]] ], 27 ['1,2-4' , '1-4' , '1,2,3,4' , [[1,4]] ], 28 ['1-3,4,5-7' , '1-7' , '1,2,3,4,5,6,7', [[1,7]] ], 29 ['1-3,4' , '1-4' , '1,2,3,4' , [[1,4]] ], 30 ['1,2,4,5,6,7' , '1-2,4-7', '1,2,4,5,6,7' , [[1,2],[4,7]] ], 31 ['1,2-)' , '1-)' , $Err , [[1,undef]] ], 32 ['(-0,1-)' , '(-)' , $Err , [[undef,undef]] ], 33 ['(-)' , '(-)' , $Err , [[undef,undef]] ], 34 ['1-)' , '1-)' , $Err , [[1,undef]] ], 35 ['(-1' , '(-1' , $Err , [[undef,1]] ], 36 ['-3,-1-)' , '-3,-1-)', $Err , [[-3,-3],[-1,undef]]], 37 ['(-1,3' , '(-1,3' , $Err , [[undef,1],[3,3]] ], 38); 39 40my @New_list = 41( 42 ['1', '2', '1-2'], 43 ['1-5', '2', '1-5'], 44 ['1-5', '2-8', '1-8'], 45 ['1-5', '2-8', '10-20', '1-8,10-20'], 46 ['(-5', '2-8', '10-20', '(-8,10-20'], 47 ['(-5', '2-8', '10-)', '(-8,10-)'], 48 ['40-45', '20-25', '10-15', '1', '12-13', '1,10-15,20-25,40-45' ] 49); 50 51my @New_array = 52( 53 [ [ ], "-" ], 54 [ [ 1 ], "1" ], 55 [ [ 1, 1 ], "1" ], 56 [ [ 1, 2 ], "1-2" ], 57 [ [ 1, 2, 2 ], "1-2" ], 58 [ [ 1, 3, 3 ], "1,3" ], 59 [ [ 1, 3 ], "1,3" ], 60 [ [ 1, 3, 3 ], "1,3" ], 61 [ [ 1, 3, 4 ], "1,3,4" ], 62 [ [ 1, 3, 4, 4 ], "1,3,4" ], 63 [ [ 1, 2, 4 ], "1-2,4" ], 64 [ [ 1, 2, 4, 4 ], "1-2,4" ], 65 [ [ 1, 2, 4, 5 ], "1-2,4-5" ], 66 [ [ 1, 2, 4, 5, 5 ], "1-2,4-5" ], 67 [ [ 3, 2, 1 ], "1-3" ], 68 [ [ [ undef, -1 ] ], "(--1" ], 69 [ [ 5, [ undef, 1 ], 3 ], "(-1,3,5" ], 70 [ [ 5, [ undef, 1 ], 3, 4 ], "(-1,3-5" ], 71 [ [ 5, [ undef, 1 ], 3, [ 8, undef ], 4 ], "(-1,3-5,8-)" ], 72 [ [ 5, [ undef, 1 ], 3, [ 6, undef ], 4 ], "(-1,3-)" ], 73 [ [ 5, [ undef, 2 ], 3, [ 4, undef ], 4 ], "(-)" ], 74 [ [ [ 1, 5 ], [ 3, 8 ], 27 ], "1-8,27" ], 75 [ [ 1, [ 5, 8 ], 5, [ 7, 9 ], 2 ], "1-2,5-9" ], 76); 77 78print "1..", @New * 7 + @New_list + @New_array, "\n"; 79New (); 80Elements (); 81Sets (); 82Spans (); 83New_list (); 84New_array(); 85 86 87sub New 88{ 89 print "#new\n"; 90 91 for my $test (@New) 92 { 93 my $set = new Set::IntSpan $test->[0]; 94 my $result = $set->run_list(); 95 printf "#new %-14s -> %s\n", $test->[0], $result; 96 $result eq $test->[1] or Not; OK 97 98 my $copy = new Set::IntSpan $set; 99 $result = $copy->run_list(); 100 printf "#new %-14s -> %s\n", $test->[0], $result; 101 $result eq $test->[1] or Not; OK; 102 } 103} 104 105 106sub Elements 107{ 108 print "#elements\n"; 109 110 my($set, $expected, @elements, $elements, $result); 111 112 for my $t (@New) 113 { 114 $set = new Set::IntSpan $t->[0]; 115 $expected = $t->[2]; 116 117 eval { @elements = elements $set }; 118 if ($@) 119 { 120 printf "#elements %-14s -> %s\n", $t->[0], $@; 121 $@ =~/$expected/ or Not; OK; 122 } 123 else 124 { 125 $result = join(',', @elements ); 126 printf "#elements %-14s -> %s\n", $t->[0], $result; 127 $result eq $expected or Not; OK; 128 } 129 130 eval { $elements = elements $set }; 131 if ($@) 132 { 133 printf "#elements %-14s -> %s\n", $t->[0], $@; 134 $@ =~ /$expected/ or Not; OK; 135 } 136 else 137 { 138 $result = join(',', @$elements ); 139 printf "#elements %-14s -> %s\n", $t->[0], $result; 140 $result eq $expected or Not; OK; 141 } 142 } 143} 144 145sub Sets 146{ 147 print "#sets\n"; 148 149 for my $t (@New) 150 { 151 my $set = new Set::IntSpan $t->[0]; 152 my @sets = sets $set; 153 my @expected = map { $_ eq '-' 154 ? () 155 : new Set::IntSpan $_ } split /,/, $t->[1]; 156 157 equal_sets(\@sets, \@expected) or Not; OK; 158 } 159} 160 161sub equal_sets 162{ 163 my($a, $b) = @_; 164 165 @$a == @$b or return 0; 166 167 while (@$a) 168 { 169 my $a = shift @$a; 170 my $b = shift @$b; 171 172 ref $a eq 'Set::IntSpan' or return 0; 173 ref $b eq 'Set::IntSpan' or return 0; 174 175 equal $a $b or return 0; 176 } 177 178 1 179} 180 181sub Spans 182{ 183 print "#spans\n"; 184 185 for my $t (@New) 186 { 187 my $set1 = new Set::IntSpan $t->[0]; 188 my @spans = spans $set1; 189 my $expected = $t->[3]; 190 equal_lists(\@spans, $expected) or Not; OK; 191 192 my $set2 = new Set::IntSpan $t->[3]; 193 equal $set1 $set2 or Not; OK; 194 print "set1 $set1, set2 $set2\n"; 195 196 } 197} 198 199sub equal_lists 200{ 201 my($a, $b) = @_; 202 203 # print "a <@$a>, b <@$b>\n"; 204 @$a==@$b or return 0; 205 206 my @a = @$a; 207 my @b = @$b; 208 209 while (@a) 210 { 211 my $aa = shift @a; 212 my $bb = shift @b; 213 214 if (ref $aa and ref $bb) { equal_lists($aa, $bb) or return 0 } 215 elsif (defined $aa and defined $bb) { $aa == $bb or return 0 } 216 else { not defined $aa and not defined $bb or return 0 } 217 } 218 219 1 220} 221 222 223sub New_list 224{ 225 for my $t (@New_list) 226 { 227 my @run_lists = @$t; 228 my $expected = pop @run_lists; 229 my $set = new Set::IntSpan @run_lists; 230 my $actual = $set->run_list; 231 $set->equal($expected) or Not; OK; 232 } 233} 234 235 236sub New_array 237{ 238 for my $t (@New_array) 239 { 240 my $actual = new Set::IntSpan $t->[0]; 241 my $expected = $t->[1]; 242 $actual eq $expected or Not; OK; 243 } 244} 245