Commit | Line | Data |
43fd88df |
1 | #!/usr/bin/perl -w |
2 | |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = ('../lib', 'lib'); |
7 | } |
8 | else { |
9 | unshift @INC, 't/lib'; |
10 | } |
11 | } |
12 | |
13 | use strict; |
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); |
20 | local $ENV{HARNESS_ACTIVE} = 0; |
21 | |
22 | |
23 | # Can't use Test.pm, that's a 5.005 thing. |
24 | package main; |
25 | |
26 | |
27 | my $TB = Test::Builder->create; |
845d7e37 |
28 | $TB->plan(tests => 73); |
43fd88df |
29 | |
30 | # Utility testing functions. |
31 | sub ok ($;$) { |
32 | return $TB->ok(@_); |
33 | } |
34 | |
35 | sub is ($$;$) { |
36 | my($this, $that, $name) = @_; |
37 | |
38 | my $ok = $TB->is_eq($$this, $that, $name); |
39 | |
40 | $$this = ''; |
41 | |
42 | return $ok; |
43 | } |
44 | |
45 | sub like ($$;$) { |
46 | my($this, $regex, $name) = @_; |
b1ddf169 |
47 | $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; |
43fd88df |
48 | |
49 | my $ok = $TB->like($$this, $regex, $name); |
50 | |
51 | $$this = ''; |
52 | |
53 | return $ok; |
54 | } |
55 | |
56 | |
57 | require Test::More; |
58 | Test::More->import(tests => 11, import => ['is_deeply']); |
59 | |
60 | my $Filename = quotemeta $0; |
61 | |
62 | #line 68 |
63 | ok !is_deeply('foo', 'bar', 'plain strings'); |
64 | is( $out, "not ok 1 - plain strings\n", 'plain strings' ); |
65 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
66 | # Failed test 'plain strings' |
b7f9bbeb |
67 | # at $0 line 68. |
43fd88df |
68 | # got: 'foo' |
69 | # expected: 'bar' |
70 | ERR |
71 | |
72 | |
73 | #line 78 |
74 | ok !is_deeply({}, [], 'different types'); |
75 | is( $out, "not ok 2 - different types\n", 'different types' ); |
76 | like( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
77 | # Failed test 'different types' |
b7f9bbeb |
78 | # at $Filename line 78. |
43fd88df |
79 | # Structures begin differing at: |
80 | # \\\$got = HASH\\(0x[0-9a-f]+\\) |
81 | # \\\$expected = ARRAY\\(0x[0-9a-f]+\\) |
82 | ERR |
83 | |
84 | #line 88 |
85 | ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); |
86 | is( $out, "not ok 3 - hashes with different values\n", |
87 | 'hashes with different values' ); |
88 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
89 | # Failed test 'hashes with different values' |
b7f9bbeb |
90 | # at $0 line 88. |
43fd88df |
91 | # Structures begin differing at: |
92 | # \$got->{this} = '42' |
93 | # \$expected->{this} = '43' |
94 | ERR |
95 | |
96 | #line 99 |
97 | ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); |
98 | is( $out, "not ok 4 - hashes with different keys\n", |
99 | 'hashes with different keys' ); |
100 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
101 | # Failed test 'hashes with different keys' |
b7f9bbeb |
102 | # at $0 line 99. |
43fd88df |
103 | # Structures begin differing at: |
104 | # \$got->{this} = Does not exist |
105 | # \$expected->{this} = '42' |
106 | ERR |
107 | |
108 | #line 110 |
109 | ok !is_deeply([1..9], [1..10], 'arrays of different length'); |
110 | is( $out, "not ok 5 - arrays of different length\n", |
111 | 'arrays of different length' ); |
112 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
113 | # Failed test 'arrays of different length' |
b7f9bbeb |
114 | # at $0 line 110. |
43fd88df |
115 | # Structures begin differing at: |
116 | # \$got->[9] = Does not exist |
117 | # \$expected->[9] = '10' |
118 | ERR |
119 | |
120 | #line 121 |
121 | ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); |
122 | is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); |
123 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
124 | # Failed test 'arrays of undefs' |
b7f9bbeb |
125 | # at $0 line 121. |
43fd88df |
126 | # Structures begin differing at: |
127 | # \$got->[1] = undef |
128 | # \$expected->[1] = Does not exist |
129 | ERR |
130 | |
131 | #line 131 |
132 | ok !is_deeply({ foo => undef }, {}, 'hashes of undefs' ); |
133 | is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); |
134 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
135 | # Failed test 'hashes of undefs' |
b7f9bbeb |
136 | # at $0 line 131. |
43fd88df |
137 | # Structures begin differing at: |
138 | # \$got->{foo} = undef |
139 | # \$expected->{foo} = Does not exist |
140 | ERR |
141 | |
142 | #line 141 |
143 | ok !is_deeply(\42, \23, 'scalar refs'); |
144 | is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); |
145 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
146 | # Failed test 'scalar refs' |
b7f9bbeb |
147 | # at $0 line 141. |
43fd88df |
148 | # Structures begin differing at: |
149 | # \${ \$got} = '42' |
150 | # \${\$expected} = '23' |
151 | ERR |
152 | |
153 | #line 151 |
154 | ok !is_deeply([], \23, 'mixed scalar and array refs'); |
155 | is( $out, "not ok 9 - mixed scalar and array refs\n", |
156 | 'mixed scalar and array refs' ); |
157 | like( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
158 | # Failed test 'mixed scalar and array refs' |
b7f9bbeb |
159 | # at $Filename line 151. |
43fd88df |
160 | # Structures begin differing at: |
161 | # \\\$got = ARRAY\\(0x[0-9a-f]+\\) |
162 | # \\\$expected = SCALAR\\(0x[0-9a-f]+\\) |
163 | ERR |
164 | |
165 | |
166 | my($a1, $a2, $a3); |
167 | $a1 = \$a2; $a2 = \$a3; |
168 | $a3 = 42; |
169 | |
170 | my($b1, $b2, $b3); |
171 | $b1 = \$b2; $b2 = \$b3; |
172 | $b3 = 23; |
173 | |
174 | #line 173 |
175 | ok !is_deeply($a1, $b1, 'deep scalar refs'); |
176 | is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); |
177 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
178 | # Failed test 'deep scalar refs' |
b7f9bbeb |
179 | # at $0 line 173. |
43fd88df |
180 | # Structures begin differing at: |
181 | # \${\${ \$got}} = '42' |
182 | # \${\${\$expected}} = '23' |
183 | ERR |
184 | |
185 | # I don't know how to properly display this structure. |
186 | # $a2 = { foo => \$a3 }; |
187 | # $b2 = { foo => \$b3 }; |
188 | # is_deeply([$a1], [$b1], 'deep mixed scalar refs'); |
189 | |
190 | my $foo = { |
191 | this => [1..10], |
192 | that => { up => "down", left => "right" }, |
193 | }; |
194 | |
195 | my $bar = { |
196 | this => [1..10], |
197 | that => { up => "down", left => "right", foo => 42 }, |
198 | }; |
199 | |
200 | #line 198 |
201 | ok !is_deeply( $foo, $bar, 'deep structures' ); |
202 | ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); |
203 | is( $out, "not ok 11 - deep structures\n", 'deep structures' ); |
204 | is( $err, <<ERR, ' right diagnostic' ); |
b1ddf169 |
205 | # Failed test 'deep structures' |
b7f9bbeb |
206 | # at $0 line 198. |
43fd88df |
207 | # Structures begin differing at: |
208 | # \$got->{that}{foo} = Does not exist |
209 | # \$expected->{that}{foo} = '42' |
210 | ERR |
211 | |
212 | |
213 | #line 221 |
214 | my @tests = ([], |
215 | [qw(42)], |
216 | [qw(42 23), qw(42 23)] |
217 | ); |
218 | |
219 | foreach my $test (@tests) { |
220 | my $num_args = @$test; |
221 | |
222 | my $warning; |
223 | local $SIG{__WARN__} = sub { $warning .= join '', @_; }; |
224 | ok !is_deeply(@$test); |
225 | |
226 | like \$warning, |
b1ddf169 |
227 | "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/"; |
43fd88df |
228 | } |
229 | |
230 | |
231 | #line 240 |
232 | # [rt.cpan.org 6837] |
233 | ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; |
234 | ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); |
235 | |
236 | |
237 | #line 258 |
238 | # [rt.cpan.org 7031] |
239 | my $a = []; |
240 | ok !is_deeply($a, $a.''), "don't compare refs like strings"; |
241 | ok !is_deeply([$a], [$a.'']), " even deep inside"; |
242 | |
243 | |
244 | #line 265 |
245 | # [rt.cpan.org 7030] |
246 | ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; |
247 | ok !is_deeply( [], [[]] ); |
248 | |
249 | |
250 | #line 273 |
251 | $$err = $$out = ''; |
252 | ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); |
253 | is( $out, "not ok 20\n", 'scalar refs in an array' ); |
254 | is( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
255 | # Failed test at $0 line 274. |
43fd88df |
256 | # Structures begin differing at: |
257 | # \$got->[1] = 'b' |
258 | # \$expected->[1] = 'c' |
259 | ERR |
260 | |
261 | |
262 | #line 285 |
263 | my $ref = \23; |
264 | ok !is_deeply( 23, $ref ); |
265 | is( $out, "not ok 21\n", 'scalar vs ref' ); |
266 | is( $err, <<ERR, ' right diagnostic'); |
b7f9bbeb |
267 | # Failed test at $0 line 286. |
43fd88df |
268 | # Structures begin differing at: |
269 | # \$got = '23' |
270 | # \$expected = $ref |
271 | ERR |
272 | |
273 | #line 296 |
274 | ok !is_deeply( $ref, 23 ); |
275 | is( $out, "not ok 22\n", 'ref vs scalar' ); |
276 | is( $err, <<ERR, ' right diagnostic'); |
b7f9bbeb |
277 | # Failed test at $0 line 296. |
43fd88df |
278 | # Structures begin differing at: |
279 | # \$got = $ref |
280 | # \$expected = '23' |
281 | ERR |
282 | |
283 | #line 306 |
284 | ok !is_deeply( undef, [] ); |
285 | is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' ); |
286 | like( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
287 | # Failed test at $Filename line 306\\. |
43fd88df |
288 | # Structures begin differing at: |
289 | # \\\$got = undef |
290 | # \\\$expected = ARRAY\\(0x[0-9a-f]+\\) |
291 | ERR |
292 | |
293 | |
294 | # rt.cpan.org 8865 |
295 | { |
296 | my $array = []; |
297 | my $hash = {}; |
298 | |
299 | #line 321 |
300 | ok !is_deeply( $array, $hash ); |
301 | is( $out, "not ok 24\n", 'is_deeply and different reference types' ); |
302 | is( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
303 | # Failed test at $0 line 321. |
43fd88df |
304 | # Structures begin differing at: |
305 | # \$got = $array |
306 | # \$expected = $hash |
307 | ERR |
308 | |
309 | #line 332 |
310 | ok !is_deeply( [$array], [$hash] ); |
311 | is( $out, "not ok 25\n", 'nested different ref types' ); |
312 | is( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
313 | # Failed test at $0 line 332. |
43fd88df |
314 | # Structures begin differing at: |
315 | # \$got->[0] = $array |
316 | # \$expected->[0] = $hash |
317 | ERR |
318 | |
319 | |
82d700dc |
320 | # Overloaded object tests |
321 | { |
43fd88df |
322 | my $foo = bless [], "Foo"; |
323 | my $bar = bless {}, "Bar"; |
324 | |
325 | { |
326 | package Bar; |
b1ddf169 |
327 | "overload"->import(q[""] => sub { "wibble" }); |
43fd88df |
328 | } |
329 | |
330 | #line 353 |
331 | ok !is_deeply( [$foo], [$bar] ); |
332 | is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); |
333 | is( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
334 | # Failed test at $0 line 353. |
43fd88df |
335 | # Structures begin differing at: |
336 | # \$got->[0] = $foo |
337 | # \$expected->[0] = 'wibble' |
338 | ERR |
339 | |
340 | } |
43fd88df |
341 | } |
845d7e37 |
342 | |
343 | |
344 | # rt.cpan.org 14746 |
345 | { |
346 | # line 349 |
347 | ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; |
348 | is( $out, "not ok 27\n" ); |
349 | like( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
350 | # Failed test at $Filename line 349. |
845d7e37 |
351 | # Structures begin differing at: |
352 | # \\\$got = CODE\\(0x[0-9a-f]+\\) |
353 | # \\\$expected = CODE\\(0x[0-9a-f]+\\) |
354 | ERR |
355 | |
356 | |
357 | use Symbol; |
358 | my $glob1 = gensym; |
359 | my $glob2 = gensym; |
360 | |
361 | #line 357 |
362 | ok !is_deeply( $glob1, $glob2 ), 'typeglobs'; |
363 | is( $out, "not ok 28\n" ); |
364 | like( $err, <<ERR, ' right diagnostic' ); |
b7f9bbeb |
365 | # Failed test at $Filename line 357. |
845d7e37 |
366 | # Structures begin differing at: |
367 | # \\\$got = GLOB\\(0x[0-9a-f]+\\) |
368 | # \\\$expected = GLOB\\(0x[0-9a-f]+\\) |
369 | ERR |
370 | |
371 | } |