1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
# -*- perl -*-
use strict;
use Set::IntSpan 1.17;
my $N = 1;
sub Not { print "not " }
sub OK { print "ok ", $N++, "\n" }
my $Sets = [ split(' ', q{ - (-) (-0 0-) 1 5 1-5 3-7 1-3,8,10-23 }) ];
my $Equal =
[[qw( 1 0 0 0 0 0 0 0 0 )],
[qw( 0 1 0 0 0 0 0 0 0 )],
[qw( 0 0 1 0 0 0 0 0 0 )],
[qw( 0 0 0 1 0 0 0 0 0 )],
[qw( 0 0 0 0 1 0 0 0 0 )],
[qw( 0 0 0 0 0 1 0 0 0 )],
[qw( 0 0 0 0 0 0 1 0 0 )],
[qw( 0 0 0 0 0 0 0 1 0 )],
[qw( 0 0 0 0 0 0 0 0 1 )]];
my $Equivalent =
[[qw( 1 0 0 0 0 0 0 0 0 )],
[qw( 0 1 1 1 0 0 0 0 0 )],
[qw( 0 1 1 1 0 0 0 0 0 )],
[qw( 0 1 1 1 0 0 0 0 0 )],
[qw( 0 0 0 0 1 1 0 0 0 )],
[qw( 0 0 0 0 1 1 0 0 0 )],
[qw( 0 0 0 0 0 0 1 1 0 )],
[qw( 0 0 0 0 0 0 1 1 0 )],
[qw( 0 0 0 0 0 0 0 0 1 )]];
my $Superset =
[[qw( 1 0 0 0 0 0 0 0 0 )],
[qw( 1 1 1 1 1 1 1 1 1 )],
[qw( 1 0 1 0 0 0 0 0 0 )],
[qw( 1 0 0 1 1 1 1 1 1 )],
[qw( 1 0 0 0 1 0 0 0 0 )],
[qw( 1 0 0 0 0 1 0 0 0 )],
[qw( 1 0 0 0 1 1 1 0 0 )],
[qw( 1 0 0 0 0 1 0 1 0 )],
[qw( 1 0 0 0 1 0 0 0 1 )]];
my $Subset =
[[qw( 1 1 1 1 1 1 1 1 1 )],
[qw( 0 1 0 0 0 0 0 0 0 )],
[qw( 0 1 1 0 0 0 0 0 0 )],
[qw( 0 1 0 1 0 0 0 0 0 )],
[qw( 0 1 0 1 1 0 1 0 1 )],
[qw( 0 1 0 1 0 1 1 1 0 )],
[qw( 0 1 0 1 0 0 1 0 0 )],
[qw( 0 1 0 1 0 0 0 1 0 )],
[qw( 0 1 0 1 0 0 0 0 1 )]];
print "1..", 4 * @$Sets * @$Sets, "\n";
Equal ();
Equivalent();
Superset ();
Subset ();
sub Equal { Relation("equal" , $Sets, $Equal ) }
sub Equivalent { Relation("equivalent", $Sets, $Equivalent) }
sub Superset { Relation("superset" , $Sets, $Superset ) }
sub Subset { Relation("subset" , $Sets, $Subset ) }
sub Relation
{
my($method, $sets, $expected) = @_;
print "#$method\n";
for (my $i=0; $i<@{$sets}; $i++)
{
for (my $j=0; $j<@{$sets}; $j++)
{
Relation_1($method, $sets->[$i], $sets->[$j], $expected->[$i][$j]);
}
}
}
sub Relation_1
{
my($method, $op1, $op2, $expected) = @_;
my $result;
my $set1 = new Set::IntSpan $op1;
my $set2 = new Set::IntSpan $op2;
$result = $set1->$method($set2);
printf "#%-12s %-12s %-12s -> %d\n", $method, $op1, $op2, $result;
$result ? $expected : ! $expected or Not; OK;
}
|
