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 12# A B U I X A-B B-A 13my @Binaries = Table <<TABLE; 14 - - - - - - - 15 - (-) (-) - (-) - (-) 16 (-) (-) (-) (-) - - - 17 (-) (-1 (-) (-1 2-) 2-) - 18 (-0 1-) (-) - (-) (-0 1-) 19 (-0 2-) (-0,2-) - (-0,2-) (-0 2-) 20 (-2 0-) (-) 0-2 (--1,3-) (--1 3-) 21 1 1 1 1 - - - 22 1 2 1-2 - 1-2 1 2 23 3-9 1-2 1-9 - 1-9 3-9 1-2 24 3-9 1-5 1-9 3-5 1-2,6-9 6-9 1-2 25 3-9 4-8 3-9 4-8 3,9 3,9 - 26 3-9 5-12 3-12 5-9 3-4,10-12 3-4 10-12 27 3-9 10-12 3-12 - 3-12 3-9 10-12 28 1-3,5,8-11 1-6 1-6,8-11 1-3,5 4,6,8-11 8-11 4,6 29TABLE 30 31print "1..", 16 * @Binaries, "\n"; 32Union (); 33Intersect(); 34Xor (); 35Diff (); 36 37 38sub Union 39{ 40 print "#union\n"; 41 42 for my $t (@Binaries) 43 { 44 Binary("union", $t->[0], $t->[1], $t->[2]); 45 Binary("union", $t->[1], $t->[0], $t->[2]); 46 B ("U" , $t->[0], $t->[1], $t->[2]); 47 B ("U" , $t->[1], $t->[0], $t->[2]); 48 } 49} 50 51 52sub Intersect 53{ 54 print "#intersect\n"; 55 56 for my $t (@Binaries) 57 { 58 Binary("intersect", $t->[0], $t->[1], $t->[3]); 59 Binary("intersect", $t->[1], $t->[0], $t->[3]); 60 B ("I" , $t->[0], $t->[1], $t->[3]); 61 B ("I" , $t->[1], $t->[0], $t->[3]); 62 } 63} 64 65 66sub Xor 67{ 68 print "#xor\n"; 69 70 for my $t (@Binaries) 71 { 72 Binary("xor", $t->[0], $t->[1], $t->[4]); 73 Binary("xor", $t->[1], $t->[0], $t->[4]); 74 B ("X" , $t->[0], $t->[1], $t->[4]); 75 B ("X" , $t->[1], $t->[0], $t->[4]); 76 } 77} 78 79 80sub Diff 81{ 82 print "#diff\n"; 83 84 for my $t (@Binaries) 85 { 86 Binary("diff", $t->[0], $t->[1], $t->[5]); 87 Binary("diff", $t->[1], $t->[0], $t->[6]); 88 B ("D" , $t->[0], $t->[1], $t->[5]); 89 B ("D" , $t->[1], $t->[0], $t->[6]); 90 } 91} 92 93 94sub Binary 95{ 96 my($method, $op1, $op2, $expected) = @_; 97 my $set1 = new Set::IntSpan $op1; 98 my $set2 = new Set::IntSpan $op2; 99 my $setE = $set1->$method($set2); 100 my $run_list = run_list $setE; 101 102 printf "#%-12s %-10s %-10s -> %-10s\n", $method, $op1, $op2, $run_list; 103 $run_list eq $expected or Not; OK; 104} 105 106sub B 107{ 108 my($method, $op1, $op2, $expected) = @_; 109 my $set1 = new Set::IntSpan $op1; 110 my $set2 = new Set::IntSpan $op2; 111 $set1->$method($set2); 112 my $run_list = run_list $set1; 113 114 printf "#%-12s %-10s %-10s -> %-10s\n", $method, $op1, $op2, $run_list; 115 $run_list eq $expected or Not; OK; 116} 117 118 119