Commit | Line | Data |
a9153838 |
1 | #!/usr/bin/perl -w |
33459055 |
2 | |
3 | BEGIN { |
a9153838 |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = ('../lib', 'lib'); |
7 | } |
8 | else { |
9 | unshift @INC, 't/lib'; |
10 | } |
33459055 |
11 | } |
12 | |
13 | use strict; |
33459055 |
14 | |
15 | use Test::Builder; |
16 | require Test::Simple::Catch; |
17 | my($out, $err) = Test::Simple::Catch::caught(); |
18 | Test::Builder->new->no_header(1); |
19 | Test::Builder->new->no_ending(1); |
30e302f8 |
20 | local $ENV{HARNESS_ACTIVE} = 0; |
21 | |
33459055 |
22 | |
23 | # Can't use Test.pm, that's a 5.005 thing. |
24 | package main; |
25 | |
0257f296 |
26 | print "1..38\n"; |
33459055 |
27 | |
28 | my $test_num = 1; |
29 | # Utility testing functions. |
7483b81c |
30 | sub ok ($;$) { |
31 | my($test, $name) = @_; |
32 | my $ok = ''; |
33 | $ok .= "not " unless $test; |
34 | $ok .= "ok $test_num"; |
35 | $ok .= " - $name" if defined $name; |
36 | $ok .= "\n"; |
37 | print $ok; |
38 | $test_num++; |
39 | |
40 | return $test; |
41 | } |
42 | |
33459055 |
43 | sub is ($$;$) { |
44 | my($this, $that, $name) = @_; |
45 | my $test = $$this eq $that; |
46 | my $ok = ''; |
47 | $ok .= "not " unless $test; |
48 | $ok .= "ok $test_num"; |
49 | $ok .= " - $name" if defined $name; |
50 | $ok .= "\n"; |
51 | print $ok; |
52 | |
53 | unless( $test ) { |
54 | print "# got \n$$this"; |
55 | print "# expected \n$that"; |
56 | } |
57 | $test_num++; |
58 | |
59 | $$this = ''; |
60 | |
61 | return $test; |
62 | } |
63 | |
64 | sub like ($$;$) { |
65 | my($this, $regex, $name) = @_; |
7483b81c |
66 | |
30e302f8 |
67 | $regex = qr/$regex/ unless ref $regex; |
68 | my $test = $$this =~ $regex; |
33459055 |
69 | |
70 | my $ok = ''; |
71 | $ok .= "not " unless $test; |
72 | $ok .= "ok $test_num"; |
73 | $ok .= " - $name" if defined $name; |
74 | $ok .= "\n"; |
75 | print $ok; |
76 | |
77 | unless( $test ) { |
78 | print "# got \n$$this"; |
79 | print "# expected \n$regex"; |
80 | } |
81 | $test_num++; |
82 | |
83 | $$this = ''; |
84 | |
85 | |
86 | return $test; |
87 | } |
88 | |
89 | |
90 | require Test::More; |
91 | Test::More->import(tests => 11, import => ['is_deeply']); |
92 | |
93 | my $Filename = quotemeta $0; |
94 | |
95 | #line 68 |
96 | is_deeply('foo', 'bar', 'plain strings'); |
97 | is( $out, "not ok 1 - plain strings\n", 'plain strings' ); |
98 | is( $err, <<ERR, ' right diagnostic' ); |
99 | # Failed test ($0 at line 68) |
100 | # got: 'foo' |
101 | # expected: 'bar' |
102 | ERR |
103 | |
104 | |
105 | #line 78 |
106 | is_deeply({}, [], 'different types'); |
107 | is( $out, "not ok 2 - different types\n", 'different types' ); |
108 | like( $err, <<ERR, ' right diagnostic' ); |
109 | # Failed test \\($Filename at line 78\\) |
110 | # Structures begin differing at: |
2f71ccc2 |
111 | # \\\$got = 'HASH\\(0x[0-9a-f]+\\)' |
112 | # \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)' |
33459055 |
113 | ERR |
114 | |
115 | #line 88 |
116 | is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); |
117 | is( $out, "not ok 3 - hashes with different values\n", |
118 | 'hashes with different values' ); |
119 | is( $err, <<ERR, ' right diagnostic' ); |
120 | # Failed test ($0 at line 88) |
121 | # Structures begin differing at: |
122 | # \$got->{this} = '42' |
123 | # \$expected->{this} = '43' |
124 | ERR |
125 | |
126 | #line 99 |
127 | is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); |
128 | is( $out, "not ok 4 - hashes with different keys\n", |
129 | 'hashes with different keys' ); |
130 | is( $err, <<ERR, ' right diagnostic' ); |
131 | # Failed test ($0 at line 99) |
132 | # Structures begin differing at: |
133 | # \$got->{this} = Does not exist |
134 | # \$expected->{this} = '42' |
135 | ERR |
136 | |
137 | #line 110 |
138 | is_deeply([1..9], [1..10], 'arrays of different length'); |
139 | is( $out, "not ok 5 - arrays of different length\n", |
140 | 'arrays of different length' ); |
141 | is( $err, <<ERR, ' right diagnostic' ); |
142 | # Failed test ($0 at line 110) |
143 | # Structures begin differing at: |
144 | # \$got->[9] = Does not exist |
145 | # \$expected->[9] = '10' |
146 | ERR |
147 | |
148 | #line 121 |
149 | is_deeply([undef, undef], [undef], 'arrays of undefs' ); |
150 | is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); |
151 | is( $err, <<ERR, ' right diagnostic' ); |
152 | # Failed test ($0 at line 121) |
153 | # Structures begin differing at: |
154 | # \$got->[1] = undef |
155 | # \$expected->[1] = Does not exist |
156 | ERR |
157 | |
158 | #line 131 |
30e302f8 |
159 | is_deeply({ foo => undef }, {}, 'hashes of undefs' ); |
33459055 |
160 | is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); |
161 | is( $err, <<ERR, ' right diagnostic' ); |
162 | # Failed test ($0 at line 131) |
163 | # Structures begin differing at: |
164 | # \$got->{foo} = undef |
165 | # \$expected->{foo} = Does not exist |
166 | ERR |
167 | |
168 | #line 141 |
169 | is_deeply(\42, \23, 'scalar refs'); |
170 | is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); |
171 | is( $err, <<ERR, ' right diagnostic' ); |
172 | # Failed test ($0 at line 141) |
173 | # Structures begin differing at: |
174 | # \${ \$got} = '42' |
175 | # \${\$expected} = '23' |
176 | ERR |
177 | |
178 | #line 151 |
179 | is_deeply([], \23, 'mixed scalar and array refs'); |
180 | is( $out, "not ok 9 - mixed scalar and array refs\n", |
181 | 'mixed scalar and array refs' ); |
182 | like( $err, <<ERR, ' right diagnostic' ); |
183 | # Failed test \\($Filename at line 151\\) |
184 | # Structures begin differing at: |
2f71ccc2 |
185 | # \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)' |
186 | # \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)' |
33459055 |
187 | ERR |
188 | |
189 | |
190 | my($a1, $a2, $a3); |
191 | $a1 = \$a2; $a2 = \$a3; |
192 | $a3 = 42; |
193 | |
194 | my($b1, $b2, $b3); |
195 | $b1 = \$b2; $b2 = \$b3; |
196 | $b3 = 23; |
197 | |
198 | #line 173 |
199 | is_deeply($a1, $b1, 'deep scalar refs'); |
200 | is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); |
201 | is( $err, <<ERR, ' right diagnostic' ); |
202 | # Failed test ($0 at line 173) |
203 | # Structures begin differing at: |
204 | # \${\${ \$got}} = '42' |
205 | # \${\${\$expected}} = '23' |
206 | ERR |
207 | |
208 | # I don't know how to properly display this structure. |
209 | # $a2 = { foo => \$a3 }; |
210 | # $b2 = { foo => \$b3 }; |
211 | # is_deeply([$a1], [$b1], 'deep mixed scalar refs'); |
212 | |
213 | my $foo = { |
214 | this => [1..10], |
215 | that => { up => "down", left => "right" }, |
216 | }; |
217 | |
218 | my $bar = { |
219 | this => [1..10], |
220 | that => { up => "down", left => "right", foo => 42 }, |
221 | }; |
222 | |
223 | #line 198 |
224 | is_deeply( $foo, $bar, 'deep structures' ); |
7483b81c |
225 | ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); |
33459055 |
226 | is( $out, "not ok 11 - deep structures\n", 'deep structures' ); |
227 | is( $err, <<ERR, ' right diagnostic' ); |
228 | # Failed test ($0 at line 198) |
229 | # Structures begin differing at: |
230 | # \$got->{that}{foo} = Does not exist |
231 | # \$expected->{that}{foo} = '42' |
232 | ERR |
30e302f8 |
233 | |
234 | |
235 | #line 221 |
236 | my @tests = ([], |
237 | [qw(42)], |
238 | [qw(42 23), qw(42 23)] |
239 | ); |
240 | |
241 | foreach my $test (@tests) { |
242 | my $num_args = @$test; |
243 | |
244 | my $warning; |
245 | local $SIG{__WARN__} = sub { $warning .= join '', @_; }; |
246 | is_deeply(@$test); |
247 | |
248 | like \$warning, |
249 | qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/; |
250 | } |
7483b81c |
251 | |
252 | |
253 | #line 240 |
254 | # [rt.cpan.org 6837] |
255 | ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; |
256 | ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); |
257 | |
258 | |
259 | #line 258 |
260 | # [rt.cpan.org 7031] |
261 | my $a = []; |
262 | ok !is_deeply($a, $a.''), "don't compare refs like strings"; |
263 | ok !is_deeply([$a], [$a.'']), " even deep inside"; |
264 | |
265 | |
266 | #line 265 |
267 | # [rt.cpan.org 7030] |
268 | ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; |
269 | ok !is_deeply( [], [[]] ); |
270 | |
271 | |
272 | #line 273 |
273 | $$err = $$out = ''; |
274 | is_deeply( [\'a', 'b'], [\'a', 'c'] ); |
275 | is( $out, "not ok 20\n", 'scalar refs in an array' ); |
276 | is( $err, <<ERR, ' right diagnostic' ); |
277 | # Failed test ($0 at line 274) |
278 | # Structures begin differing at: |
279 | # \$got->[1] = 'b' |
280 | # \$expected->[1] = 'c' |
281 | ERR |
0257f296 |
282 | |
283 | |
284 | #line 285 |
285 | my $ref = \23; |
286 | is_deeply( 23, $ref ); |
287 | is( $out, "not ok 21\n", 'scalar vs ref' ); |
288 | is( $err, <<ERR, ' right diagnostic'); |
289 | # Failed test ($0 at line 286) |
290 | # Structures begin differing at: |
291 | # \$got = '23' |
292 | # \$expected = '$ref' |
293 | ERR |
294 | |
295 | #line 296 |
296 | is_deeply( $ref, 23 ); |
297 | is( $out, "not ok 22\n", 'ref vs scalar' ); |
298 | is( $err, <<ERR, ' right diagnostic'); |
299 | # Failed test ($0 at line 296) |
300 | # Structures begin differing at: |
301 | # \$got = '$ref' |
302 | # \$expected = '23' |
303 | ERR |