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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
#!/usr/bin/perl -w
use strict;
use lib qw(t/lib);
use Test::Builder;
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Builder->new->no_header(1);
Test::Builder->new->no_ending(1);
# Can't use Test.pm, that's a 5.005 thing.
package main;
print "1..22\n";
my $test_num = 1;
# Utility testing functions.
sub is ($$;$) {
my($this, $that, $name) = @_;
my $test = $$this eq $that;
my $ok = '';
$ok .= "not " unless $test;
$ok .= "ok $test_num";
$ok .= " - $name" if defined $name;
$ok .= "\n";
print $ok;
unless( $test ) {
print "# got \n$$this";
print "# expected \n$that";
}
$test_num++;
$$this = '';
return $test;
}
sub like ($$;$) {
my($this, $regex, $name) = @_;
my $test = $$this =~ /$regex/;
my $ok = '';
$ok .= "not " unless $test;
$ok .= "ok $test_num";
$ok .= " - $name" if defined $name;
$ok .= "\n";
print $ok;
unless( $test ) {
print "# got \n$$this";
print "# expected \n$regex";
}
$test_num++;
$$this = '';
return $test;
}
require Test::More;
Test::More->import(tests => 11, import => ['is_deeply']);
my $Filename = quotemeta $0;
#line 68
is_deeply('foo', 'bar', 'plain strings');
is( $out, "not ok 1 - plain strings\n", 'plain strings' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 68)
# got: 'foo'
# expected: 'bar'
ERR
#line 78
is_deeply({}, [], 'different types');
is( $out, "not ok 2 - different types\n", 'different types' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test \\($Filename at line 78\\)
# Structures begin differing at:
# \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
# \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
ERR
#line 88
is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
is( $out, "not ok 3 - hashes with different values\n",
'hashes with different values' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 88)
# Structures begin differing at:
# \$got->{this} = '42'
# \$expected->{this} = '43'
ERR
#line 99
is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
is( $out, "not ok 4 - hashes with different keys\n",
'hashes with different keys' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 99)
# Structures begin differing at:
# \$got->{this} = Does not exist
# \$expected->{this} = '42'
ERR
#line 110
is_deeply([1..9], [1..10], 'arrays of different length');
is( $out, "not ok 5 - arrays of different length\n",
'arrays of different length' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 110)
# Structures begin differing at:
# \$got->[9] = Does not exist
# \$expected->[9] = '10'
ERR
#line 121
is_deeply([undef, undef], [undef], 'arrays of undefs' );
is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 121)
# Structures begin differing at:
# \$got->[1] = undef
# \$expected->[1] = Does not exist
ERR
#line 131
is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' );
is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 131)
# Structures begin differing at:
# \$got->{foo} = undef
# \$expected->{foo} = Does not exist
ERR
#line 141
is_deeply(\42, \23, 'scalar refs');
is( $out, "not ok 8 - scalar refs\n", 'scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 141)
# Structures begin differing at:
# \${ \$got} = '42'
# \${\$expected} = '23'
ERR
#line 151
is_deeply([], \23, 'mixed scalar and array refs');
is( $out, "not ok 9 - mixed scalar and array refs\n",
'mixed scalar and array refs' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test \\($Filename at line 151\\)
# Structures begin differing at:
# \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)'
# \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)'
ERR
my($a1, $a2, $a3);
$a1 = \$a2; $a2 = \$a3;
$a3 = 42;
my($b1, $b2, $b3);
$b1 = \$b2; $b2 = \$b3;
$b3 = 23;
#line 173
is_deeply($a1, $b1, 'deep scalar refs');
is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 173)
# Structures begin differing at:
# \${\${ \$got}} = '42'
# \${\${\$expected}} = '23'
ERR
# I don't know how to properly display this structure.
# $a2 = { foo => \$a3 };
# $b2 = { foo => \$b3 };
# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
my $foo = {
this => [1..10],
that => { up => "down", left => "right" },
};
my $bar = {
this => [1..10],
that => { up => "down", left => "right", foo => 42 },
};
#line 198
is_deeply( $foo, $bar, 'deep structures' );
is( $out, "not ok 11 - deep structures\n", 'deep structures' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 198)
# Structures begin differing at:
# \$got->{that}{foo} = Does not exist
# \$expected->{that}{foo} = '42'
ERR
|
