1# -*- Mode: Perl -*-
2
3BEGIN { unshift @INC, "lib", "../lib" }
4use strict;
5use warnings;
6# use diagnostics;
7
8use Data::Compare;
9
10local $^W = 1;
11print "1..45\n";
12
13my $t = 1;
14
15my $s0 = undef;
16my $s1 = 0;
17my $s2 = 10;
18
19# 1 .. 4
20&comp($s0, $s0, 1);
21&comp($s1, $s1, 1);
22&comp($s2, $s2, 1);
23&comp($s0, $s1, 0);
24
25my $s3 = \$s2;
26my $s4 = \$s1;
27my $s5 = "$s4";
28my $s6 = 0;
29my $s7 = \$s6;
30
31# 5 .. 8
32&comp($s3, $s3, 1);
33&comp($s3, $s4, 0);
34&comp($s4, $s5, 0);
35&comp($s4, $s7, 1);
36
37my $a1 = [];
38my $a2 = [ 0 ];
39my $a3 = [ '' ];
40my $a4 = [ 1, 2, 3 ];
41my $a5 = [ 1, 2, 4 ];
42my $a6 = [ 1, 2, 3, 5 ];
43
44# 9 .. 13
45&comp($a1, $a1, 1);
46&comp($a1, $a2, 0);
47&comp($a2, $a3, 0);
48&comp($a4, $a5, 0);
49&comp($a4, $a6, 0);
50
51my $h1 = {};
52my $h2 = { 'foo' => 'bar' };
53my $h3 = { 'foo' => 'bar' };
54my $h4 = { 'foo' => 'bar', 'bar' => 'foo' };
55
56# 14 .. 19
57&comp($h1, $s0, 0);
58&comp($h1, $h1, 1);
59&comp($h2, $h2, 1);
60&comp($h2, $h3, 1);
61&comp($h1, $h2, 0);
62&comp($h3, $h4, 0);
63
64my $o1 = bless [ 'FOO', 'BAR' ], 'foo';
65my $o2 = bless [ 'FOO', 'BAR' ], 'foo';
66my $o3 = bless [ 'FOO', 'BAR' ], 'fool';
67my $o4 = bless [ 'FOO', 'BAR', 'BAZ' ], 'foo';
68
69# 20 .. 22
70&comp($o1, $o2, 1);
71&comp($o1, $o3, 0);
72&comp($o1, $o4, 0);
73
74my $o5 = bless { 'FOO' => 'BAR' }, 'foo';
75my $o6 = bless { 'FOO' => 'BAR' }, 'foo';
76my $o7 = bless { 'FOO' => 'BAR' }, 'fool';
77my $o8 = bless { 'FOO' => 'BAR', 'foo' => 'BAZ' }, 'foo';
78
79# 23 .. 25
80&comp($o5, $o6, 1);
81&comp($o5, $o7, 0);
82&comp($o5, $o8, 0);
83
84my $s8  = 0;
85my $o9  = bless \$s0, 'foo';
86my $o10 = bless \$s8, 'foo';
87my $o11 = bless \$s1, 'foo';
88
89# 26 .. 27
90&comp($o9,  $o10, 0);
91&comp($o10, $o11, 1);
92
93my $g1 = \*STDIN;
94my $g2 = \*STDOUT;
95
96# 28 .. 29
97&comp($g1, $g1, 1);
98&comp($g1, $g2, 0);
99
100my $o12 = bless $g1, 'foo';
101my $o13 = bless $g2, 'foo';
102
103# 30 .. 31
104&comp($o12, $o12, 1);
105&comp($o12, $o13, 0);
106
107my $o16 = bless sub { print "foo\n" }, 'foo';
108my $o17 = bless sub { print "foo\n" }, 'foo';
109
110# 32
111&comp($o16, $o17, 0); # :(
112
113my $v1 = { 'foo' => [ 1, { 'bar' => 'baz' }, 3 ] };
114my $v2 = { 'bar' => 'baz' };
115my $v3 = [ 1, $v2, 3 ];
116my $v4 = { 'foo' => $v3 };
117
118# 33
119&comp($v1, $v4, 1);
120
121# 34 .. 37
122&comp(\\1, \\1, 1);
123&comp(\\1, \\2, 0);
124&comp(\\1, 1, 0);
125&comp(\\1, \1, 0);
126
127# 38 .. 40
128&comp(qr/abc/i, qr/abc/i, 1, "Identical regexen");
129&comp(qr/abc/i, qr/[aA][bB][cC]/, 0, "Non-identical regexen");
130&comp(qr/abc/i, '(?i-xsm:abc)', 0, "Regex and scalar which stringify the same");
131
132# 41 .. 43
133# scalar cross
134$a = [];
135my($x, $y);
136$x=\$y;
137$y=\$x;
138$a->[0]=\$a->[1];
139$a->[1]=\$a->[0];
140&comp([$x, $y], $a, 1, "two parallel circular structures compare the same");
141
142# these two are probably superfluous, as they test referential equality
143# rather than any of the stuff we added to do with circles and recursion
144&comp([$x, $y], [$y, $x], 1, "looking at a circle from two different starting points compares the same");
145&comp([$x, $y], [$x, $y], 1, "a circular structure compares to itself");
146
147$a = [];
148$b = [];
149$a->[0] = { foo => { bar => $a } };
150$b->[0] = { foo => { bar => $b } };
151$a->[1] = $b->[1] = 5;
152comp($a, $b, 1, "structure of a circle plus same data compares the same");
153
154$a->[1] = 6;
155comp($a, $b, 0, "structure of a circle plus different data compares different");
156sub comp {
157  my $a = shift;
158  my $b = shift;
159  my $expect = shift;
160  my $comment = shift;
161
162  print Compare ($a, $b) == $expect ? "" : "not ", "ok ", $t++,
163    ($comment) ? " $comment\n" : "\n";
164}
165