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