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