1# -*- perl -*- 2 3use strict; 4use Set::IntSpan 1.17; 5 6my $N = 1; 7sub Not { print "not " } 8 9sub OK_ord 10{ 11 my $test = shift; 12 13 my($runlist, $n, $ord_exp, $span_exp) = @$test; 14 $ord_exp = '<undef>' unless defined $ord_exp; 15 print "ok $N ord : $runlist $n\t-> $ord_exp\n"; 16 $N++; 17} 18 19sub OK_span 20{ 21 my $test = shift; 22 23 my($runlist, $n, $ord_exp, $span_exp) = @$test; 24 $span_exp = defined $span_exp ? join ', ', map { defined($_) ? $_ : '<undef>' } @$span_exp : '<undef>'; 25 print "ok $N span: $runlist $n\t-> $span_exp\n"; 26 27 $N++; 28} 29 30my @Span_ord_test = 31( 32 [ '-' , 0, undef, undef ], 33 [ '(-)' , 0, 0 , [undef, undef] ], 34 [ '0' , 0, 0 , [ 0, 0] ], 35 [ '1' , 0, undef, undef ], 36 [ '1' , 1, 0 , [ 1, 1] ], 37 [ '1' , 2, undef, undef ], 38 [ '1,3-5' , 0, undef, undef ], 39 [ '1,3-5' , 1, 0 , [ 1, 1] ], 40 [ '1,3-5' , 2, undef, undef ], 41 [ '1,3-5' , 3, 1 , [ 3, 5] ], 42 [ '1,3-5' , 4, 1 , [ 3, 5] ], 43 [ '1,3-5' , 5, 1 , [ 3, 5] ], 44 [ '1,3-5' , 6, undef, undef ], 45 [ '1-)' , 0, undef, undef ], 46 [ '1-)' , 1, 0 , [ 1, undef] ], 47 [ '1-)' , 2, 0 , [ 1, undef] ], 48 [ '(-1' , 0, 0 , [undef, 1] ], 49 [ '(-1' , 1, 0 , [undef, 1] ], 50 [ '(-1' , 2, undef, undef ], 51 [ '1-5,11-15,21-25' , 21, 2 , [ 21, 25] ], 52 [ '(-5,11-15,21-25' , 21, 2 , [ 21, 25] ], 53 [ '1-5,11-15,21-25,30-40', 21, 2 , [ 21, 25] ], 54 [ '(-5,11-15,21-25,30-)' , 21, 2 , [ 21, 25] ], 55 [ '(-5,11-15,21-25,30-)' , 20, undef, undef ], 56); 57 58print "1..", 2 * @Span_ord_test, "\n"; 59 60for my $test (@Span_ord_test) 61{ 62 my($run_list, $n, $ord_exp, $span_exp) = @$test; 63 64 my $set = new Set::IntSpan $run_list; 65 my $ord_act = $set->span_ord($n); 66 identical_n($ord_act, $ord_exp) or Not; OK_ord($test); 67 68 my $span_act = defined $ord_act ? ($set->spans)[$ord_act] : undef; 69 identical_span($span_act, $span_exp) or Not; OK_span($test); 70} 71 72sub identical_n 73{ 74 my($a, $b) = @_; 75 76 not defined $a and not defined $b or 77 defined $a and defined $b and $a == $b 78} 79 80sub identical_span 81{ 82 my($a, $b) = @_; 83 84 not defined $a and not defined $b or 85 defined $a and defined $b and 86 identical_n($a->[0], $b->[0]) and identical_n($a->[1], $b->[1]) 87} 88