1# -*- perl -*- 2 3use strict; 4use Set::IntSpan 1.17 qw(grep_set map_set); 5 6my $N = 1; 7sub Not { print "not " } 8sub OK { print "ok ", $N++, "\n" } 9 10sub Equal 11{ 12 my($a, $b) = @_; 13 14 @$a==@$b or return 0; 15 while (@$a) { shift @$a == shift @$b or return 0 } 16 1 17} 18 19 20my @Sets = split(' ', q{ - (-) (-0 0-) 1 5 1-5 3-7 1-3,8,10-23 }); 21 22my @Greps = qw(1 0 $_==1 $_<5 $_&1); 23 24my @Maps = ('', split(' ', q{1 $_ -$_ $_+5 -$_,$_ $_%5})); 25 26# - (-) (-0 0-) 1 5 1-5 3-7 1--23 27my @First = (undef, undef, undef, 0, 1, 5, 1, 3, 1); 28my @Last = (undef, undef, 0, undef, 1, 5, 5, 7, 23); 29my @Start = (undef, 0, 0, 0, undef, undef, undef, undef, undef); 30 31 32print "1..", @Sets * (@Greps + @Maps + 3) + 3*16 + 2*6 + 11 + 12, "\n"; 33 34Grep (); 35Map (); 36First (); 37Last (); 38Start (); 39StartN (); 40Next (); 41Prev (); 42Current(); 43Wrap (); 44 45 46sub Grep 47{ 48 print "#grep_set\n"; 49 my @exp4 = ('-', undef, undef, undef); 50 51 my @expected = 52 ([@exp4, '1', '5', '1-5' , '3-7' , '1-3,8,10-23' ], 53 [@exp4, '-', '-', '-' , '-' , '-' ], 54 [@exp4, '1', '-', '1' , '-' , '1' ], 55 [@exp4, '1', '-', '1-4' , '3-4' , '1-3' ], 56 [@exp4, '1', '5', '1,3,5', '3,5,7', '1,3,11,13,15,17,19,21,23']); 57 58 for (my $s=0; $s<@Sets; $s++) 59 { 60 for (my $g=0; $g<@Greps; $g++) 61 { 62 my $set = new Set::IntSpan $Sets[$s]; 63 my $result = grep_set { eval $Greps[$g] } $set; 64 my $expected = $expected[$g][$s]; 65 66 my $pResult = defined $result ? $result->run_list : 'undef'; 67 printf "#%3d: grep_set { %-8s } %-12s -> %s\n", 68 $N, $Greps[$g], $Sets[$s], $pResult; 69 70 not defined $result and not defined $expected or 71 defined $result and defined $expected and 72 $result->run_list eq $expected or Not; OK; 73 } 74 } 75} 76 77 78sub Map 79{ 80 print "#map_set\n"; 81 my @exp4 = ('-', undef, undef, undef); 82 83 my @expected = 84 ([@exp4, '-' , '-' , '-' , '-' , '-' ], 85 [@exp4, '1' , '1' , '1' , '1' , '1' ], 86 [@exp4, '1' , '5' , '1-5' , '3-7' , '1-3,8,10-23' ], 87 [@exp4, '-1' , '-5' , '-5--1' , '-7--3' , '-23--10,-8,-3--1'], 88 [@exp4, '6' , '10' , '6-10' , '8-12' , '6-8,13,15-28' ], 89 [@exp4, '-1,1', '-5,5', '-5--1,1-5', '-7--3,3-7', '-23--10,-8,-3--1,1-3,8,10-23'], 90 [@exp4, '1' , '0' , '0-4' , '0-4' , '0-4' ]); 91 92 for (my $s=0; $s<@Sets; $s++) 93 { 94 for (my $m=0; $m<@Maps; $m++) 95 { 96 my $set = new Set::IntSpan $Sets[$s]; 97 my $result = map_set { eval $Maps[$m] } $set; 98 my $expected = $expected[$m][$s]; 99 100 my $pResult = defined $result ? $result->run_list : 'undef'; 101 printf "#%3d: map_set { %-8s } %-12s -> %s\n", 102 $N, $Maps[$m], $Sets[$s], $pResult; 103 104 not defined $result and not defined $expected or 105 defined $result and defined $expected and 106 $result->run_list eq $expected or Not; OK; 107 } 108 } 109} 110 111 112sub First { Terminal('first', @First); } 113sub Last { Terminal('last' , @Last ); } 114sub Start { Terminal('start', @Start); } 115 116 117sub Terminal 118{ 119 my($method, @expected) = @_; 120 print "#$method\n"; 121 122 for (my $s=0; $s<@Sets; $s++) 123 { 124 my $set = new Set::IntSpan $Sets[$s]; 125 my $result = $set->$method(0); 126 my $expected = $expected[$s]; 127 128 my $pResult = defined $result ? $result : 'undef'; 129 printf "#%3d: %-9s { %-12s } -> %s\n", 130 $N, $method, $Sets[$s], $pResult; 131 132 not defined $result and not defined $expected or 133 defined $result and defined $expected and 134 $result == $expected or Not; OK; 135 } 136} 137 138 139sub StartN 140{ 141 print "#start()\n"; 142 for my $runList ('2-5,8,10-14', '(-5,8,10-14', '2-5,8,10-)') 143 { 144 my $set = new Set::IntSpan $runList; 145 146 for my $n (0..15) 147 { 148 my $result = $set->start($n); 149 my $expected = $set->member($n) ? $n : undef; 150 151 my $pResult = defined $result ? $result : 'undef'; 152 printf "#%3d: start(%2d) { %12s } -> %s\n", 153 $N, $n, $runList, $pResult; 154 155 not defined $result and not defined $expected or 156 defined $result and defined $expected and 157 $result == $expected or Not; OK; 158 } 159 } 160} 161 162 163sub Next 164{ 165 print "#next\n"; 166 for my $runList (@Sets) 167 { 168 my $set = new Set::IntSpan $runList; 169 finite $set or next; 170 171 my @result; 172 for (my $n=$set->first; defined $n; $n=$set->next) 173 { 174 push @result, $n; 175 } 176 177 my @expected = elements $set; 178 179 printf "#%3d: next: %12s -> %s\n", 180 $N, $runList, join(',', @expected); 181 Equal(\@result, \@expected) or Not; OK; 182 } 183} 184 185 186sub Prev 187{ 188 print "#prev\n"; 189 for my $runList (@Sets) 190 { 191 my $set = new Set::IntSpan $runList; 192 finite $set or next; 193 194 my @result; 195 for (my $n=$set->last; defined $n; $n=$set->prev) 196 { 197 push @result, $n; 198 } 199 200 my @expected = reverse elements $set; 201 202 printf "#%3d: prev: %12s -> %s\n", 203 $N, $runList, join(',', @expected); 204 Equal(\@result, \@expected) or Not; OK; 205 } 206} 207 208 209sub Table { map { [ split(' ', $_) ] } split(/\n/, shift) } 210 211sub Current 212{ 213 print "#current\n"; 214 my $set = new Set::IntSpan '(-0, 3-5, 7-)'; 215 216 $set->start(0); 217 218 my @walk = Table <<TABLE; 219next 3 220prev 0 221prev -1 222next 0 223next 3 224next 4 225next 5 226next 7 227prev 5 228next 7 229next 8 230TABLE 231 232 for my $step (@walk) 233 { 234 my($direction, $expected) = @$step; 235 236 $set->$direction(); 237 my $result = $set->current; 238 239 printf "#%3d: $direction -> $result\n", $N; 240 $result==$expected or Not; OK; 241 } 242} 243 244 245sub Wrap 246{ 247 print "#wrap\n"; 248 249 my @forward = (1, 2, undef, 1, 2, undef); 250 my @backward = (2, 1, undef, 2, 1, undef); 251 252 my $set = new Set::IntSpan '1-2'; 253 254 for my $i (0..5) 255 { 256 my $result = $set->next; 257 my $expected = $forward[$i]; 258 my $pResult = defined $result ? $result : 'undef'; 259 printf "#%3d: next -> $pResult\n", $N; 260 261 not defined $result and not defined $expected or 262 defined $result and defined $expected and 263 $result == $expected or Not; OK; 264 } 265 266 for my $i (0..5) 267 { 268 my $result = $set->prev; 269 my $expected = $backward[$i]; 270 my $pResult = defined $result ? $result : 'undef'; 271 printf "#%3d: next -> $pResult\n", $N; 272 273 not defined $result and not defined $expected or 274 defined $result and defined $expected and 275 $result == $expected or Not; OK; 276 } 277} 278