1# -*- perl -*- 2 3use strict; 4use Set::IntSpan 1.17 qw(grep_spans map_spans); 5 6my $N = 1; 7sub Not { print "not " } 8sub OK { print "ok ", $N++, "\n" } 9 10my @Sets = split(' ', q{ - (-) (-0 0-) 1 5 1-3 3-7 1-3,8,10-23 1-3,8,10-23,30-) }); 11 12sub long_span 13{ 14 my($l, $u) = @$_; 15 not defined $l or 16 not defined $u or 17 $u-$l > 3 18} 19 20sub short_span 21{ 22 my($l, $u) = @$_; 23 defined $l and 24 defined $u and 25 $u-$l < 3 26} 27 28my @Greps = ('0', '1', 'long_span', 'short_span'); 29 30sub mirror 31{ 32 my($l, $u) = @$_; 33 34 if ( defined $l and defined $u) { return [ -$u , -$l ] } 35 elsif (not defined $l and defined $u) { return [ -$u , undef ] } 36 elsif ( defined $l and not defined $u) { return [ undef, -$l ] } 37 else { return [ undef, undef ] } 38} 39 40sub mirror_mirror 41{ 42 my($l, $u) = @$_; 43 44 if ( defined $l and defined $u) { return [ -$u , -$l ], [ $l , $u ] } 45 elsif (not defined $l and defined $u) { return [ -$u , undef ], [ undef , $u ] } 46 elsif ( defined $l and not defined $u) { return [ undef, -$l ], [ $l , undef] } 47 else { return [ undef, undef ], [ undef, undef ] } 48} 49 50sub double_up 51{ 52 my($l, $u) = @$_; 53 54 if ( defined $l and defined $u) { return [ 2*$l , 2*$u ] } 55 elsif (not defined $l and defined $u) { return [ undef, 2*$u ] } 56 elsif ( defined $l and not defined $u) { return [ 2*$l, undef ] } 57 else { return [ undef, undef ] } 58} 59 60sub stretch_up 61{ 62 my($l, $u) = @$_; 63 64 if ( defined $l and defined $u) { return [ $l , $u+5 ] } 65 elsif (not defined $l and defined $u) { return [ undef, $u+5 ] } 66 elsif ( defined $l and not defined $u) { return [ $l , undef ] } 67 else { return [ undef, undef ] } 68} 69 70 71my @Maps = ('()', '$_', 'mirror', 'mirror_mirror', 'double_up', 'stretch_up'); 72 73print "1..", @Sets * (@Greps + @Maps), "\n"; 74 75Grep(); 76Map (); 77 78sub Grep 79{ 80 print "#grep_span\n"; 81 82 my @expected = 83 (['-', ' - ', ' - ', ' - ', '-', '-', ' - ', ' - ', ' - ', ' - '], 84 ['-', '(-)', '(-0', '0-)', '1', '5', '1-3', '3-7', '1-3,8,10-23', '1-3,8,10-23,30-)'], 85 ['-', '(-)', '(-0', '0-)', '-', '-', ' - ', '3-7', ' 10-23', ' 10-23,30-)'], 86 ['-', ' - ', ' - ', ' - ', '1', '5', '1-3', ' - ', '1-3,8 ', '1-3,8, '], 87 ); 88 89 for (my $g=0; $g<@Greps; $g++) 90 { 91 for (my $s=0; $s<@Sets; $s++) 92 { 93 my $set = new Set::IntSpan $Sets[$s]; 94 my $result = grep_spans { eval $Greps[$g] } $set; 95 my $expected = new Set::IntSpan $expected[$g][$s]; 96 97 printf "#%3d: grep_span { %-8s } %-20s -> %s\n", 98 $N, $Greps[$g], $Sets[$s], $result->run_list; 99 100 equal $result $expected or Not; OK; 101 } 102 } 103} 104 105sub Map 106{ 107 print "#map_span\n"; 108 109 my @expected = 110 (['-', ' - ', ' - ', ' - ', ' -', ' -', ' - ' , ' - ', ' - ', ' - '], 111 ['-', '(-)', '(-0', '0-)', ' 1', ' 5', ' 1-3' , ' 3-7 ', ' 1-3,8,10-23 ', ' 1-3,8,10-23,30-) '], 112 ['-', '(-)', '0-)', '(-0', '-1', '-5', '-3--1', '-7--3', '-23--10,-8,-3--1', '(--30,-23--10,-8,-3--1'], 113 114 ['-', '(-)', '(-)', '(-)', '-1,1', '-5,5', '-3--1,1-3', '-7--3,3-7 ', 115 '-23--10,-8,-3--1,1-3,8,10-23', '(--30,-23--10,-8,-3--1, 1-3,8,10-23,30-)'], 116 117 ['-', '(-)', '(-0', '0-)', ' 2', ' 10', '2-6', '6-14', '2-6,16,20-46', '2-6,16,20-46,60-)' ], 118 ['-', '(-)', '(-5', '0-)', ' 1-6', '5-10', ' 1-8', '3-12', '1-28' , '1-28,30-)' ], 119 120 ); 121 122 for (my $g=0; $g<@Maps; $g++) 123 { 124 for (my $s=0; $s<@Sets; $s++) 125 { 126 my $set = new Set::IntSpan $Sets[$s]; 127 my $result = map_spans { eval $Maps[$g] } $set; 128 my $expected = new Set::IntSpan $expected[$g][$s]; 129 130 printf "#%3d: map_span { %-8s } %-20s -> %s\n", 131 $N, $Maps[$g], $Sets[$s], $result->run_list; 132 133 equal $result $expected or Not; OK; 134 } 135 } 136} 137