1#!/usr/bin/perl -w
2
3BEGIN {
4    if( $ENV{PERL_CORE} ) {
5        chdir 't';
6        @INC = ('../lib', 'lib');
7    }
8    else {
9        unshift @INC, 't/lib';
10    }
11}
12
13use strict;
14use warnings;
15
16use Test::Builder;
17require Test::Simple::Catch;
18my($out, $err) = Test::Simple::Catch::caught();
19Test::Builder->new->no_header(1);
20Test::Builder->new->no_ending(1);
21local $ENV{HARNESS_ACTIVE} = 0;
22
23
24# Can't use Test.pm, that's a 5.005 thing.
25package main;
26
27
28my $TB = Test::Builder->create;
29$TB->plan(tests => 110);
30
31# Utility testing functions.
32sub ok ($;$) {
33    return $TB->ok(@_);
34}
35
36sub is ($$;$) {
37    my($thing, $that, $name) = @_;
38
39    my $ok = $TB->is_eq($$thing, $that, $name);
40
41    $$thing = '';
42
43    return $ok;
44}
45
46sub like ($$;$) {
47    my($thing, $regex, $name) = @_;
48    $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
49
50    my $ok = $TB->like($$thing, $regex, $name);
51
52    $$thing = '';
53
54    return $ok;
55}
56
57
58require Test::More;
59Test::More->import(tests => 11, import => ['is_deeply']);
60
61my $Filename = quotemeta $0;
62
63#line 68
64ok !is_deeply('foo', 'bar', 'plain strings');
65is( $out, "not ok 1 - plain strings\n",     'plain strings' );
66is( $err, <<ERR,                            '    right diagnostic' );
67#   Failed test 'plain strings'
68#   at $0 line 68.
69#          got: 'foo'
70#     expected: 'bar'
71ERR
72
73
74#line 78
75ok !is_deeply({}, [], 'different types');
76is( $out, "not ok 2 - different types\n",   'different types' );
77like( $err, <<ERR,                          '   right diagnostic' );
78#   Failed test 'different types'
79#   at $Filename line 78.
80#     Structures begin differing at:
81#          \\\$got = HASH\\(0x[0-9a-f]+\\)
82#     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
83ERR
84
85#line 88
86ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
87is( $out, "not ok 3 - hashes with different values\n",
88                                        'hashes with different values' );
89is( $err, <<ERR,                        '   right diagnostic' );
90#   Failed test 'hashes with different values'
91#   at $0 line 88.
92#     Structures begin differing at:
93#          \$got->{this} = '42'
94#     \$expected->{this} = '43'
95ERR
96
97#line 99
98ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
99is( $out, "not ok 4 - hashes with different keys\n",
100                                        'hashes with different keys' );
101is( $err, <<ERR,                        '    right diagnostic' );
102#   Failed test 'hashes with different keys'
103#   at $0 line 99.
104#     Structures begin differing at:
105#          \$got->{this} = Does not exist
106#     \$expected->{this} = '42'
107ERR
108
109#line 110
110ok !is_deeply([1..9], [1..10],    'arrays of different length');
111is( $out, "not ok 5 - arrays of different length\n",
112                                        'arrays of different length' );
113is( $err, <<ERR,                        '    right diagnostic' );
114#   Failed test 'arrays of different length'
115#   at $0 line 110.
116#     Structures begin differing at:
117#          \$got->[9] = Does not exist
118#     \$expected->[9] = '10'
119ERR
120
121#line 121
122ok !is_deeply([undef, undef], [undef], 'arrays of undefs' );
123is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
124is( $err, <<ERR,                            '    right diagnostic' );
125#   Failed test 'arrays of undefs'
126#   at $0 line 121.
127#     Structures begin differing at:
128#          \$got->[1] = undef
129#     \$expected->[1] = Does not exist
130ERR
131
132#line 131
133ok !is_deeply({ foo => undef }, {},    'hashes of undefs' );
134is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
135is( $err, <<ERR,                            '    right diagnostic' );
136#   Failed test 'hashes of undefs'
137#   at $0 line 131.
138#     Structures begin differing at:
139#          \$got->{foo} = undef
140#     \$expected->{foo} = Does not exist
141ERR
142
143#line 141
144ok !is_deeply(\42, \23,   'scalar refs');
145is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
146is( $err, <<ERR,                        '    right diagnostic' );
147#   Failed test 'scalar refs'
148#   at $0 line 141.
149#     Structures begin differing at:
150#     \${     \$got} = '42'
151#     \${\$expected} = '23'
152ERR
153
154#line 151
155ok !is_deeply([], \23,    'mixed scalar and array refs');
156is( $out, "not ok 9 - mixed scalar and array refs\n",
157                                        'mixed scalar and array refs' );
158like( $err, <<ERR,                      '    right diagnostic' );
159#   Failed test 'mixed scalar and array refs'
160#   at $Filename line 151.
161#     Structures begin differing at:
162#          \\\$got = ARRAY\\(0x[0-9a-f]+\\)
163#     \\\$expected = SCALAR\\(0x[0-9a-f]+\\)
164ERR
165
166
167my($a1, $a2, $a3);
168$a1 = \$a2;  $a2 = \$a3;
169$a3 = 42;
170
171my($b1, $b2, $b3);
172$b1 = \$b2;  $b2 = \$b3;
173$b3 = 23;
174
175#line 173
176ok !is_deeply($a1, $b1, 'deep scalar refs');
177is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
178is( $err, <<ERR,                              '    right diagnostic' );
179#   Failed test 'deep scalar refs'
180#   at $0 line 173.
181#     Structures begin differing at:
182#     \${\${     \$got}} = '42'
183#     \${\${\$expected}} = '23'
184ERR
185
186# I don't know how to properly display this structure.
187# $a2 = { foo => \$a3 };
188# $b2 = { foo => \$b3 };
189# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
190
191my $foo = {
192           this => [1..10],
193           that => { up => "down", left => "right" },
194          };
195
196my $bar = {
197           this => [1..10],
198           that => { up => "down", left => "right", foo => 42 },
199          };
200
201#line 198
202ok !is_deeply( $foo, $bar, 'deep structures' );
203ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
204is( $out, "not ok 11 - deep structures\n",  'deep structures' );
205is( $err, <<ERR,                            '    right diagnostic' );
206#   Failed test 'deep structures'
207#   at $0 line 198.
208#     Structures begin differing at:
209#          \$got->{that}{foo} = Does not exist
210#     \$expected->{that}{foo} = '42'
211ERR
212
213
214#line 221
215my @tests = ([],
216             [qw(42)],
217             [qw(42 23), qw(42 23)]
218            );
219
220foreach my $test (@tests) {
221    my $num_args = @$test;
222
223    my $warning;
224    local $SIG{__WARN__} = sub { $warning .= join '', @_; };
225    ok !is_deeply(@$test);
226
227    like \$warning,
228         "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
229}
230
231
232#line 240
233# [rt.cpan.org 6837]
234ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
235ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
236
237
238#line 258
239# [rt.cpan.org 7031]
240my $a = [];
241ok !is_deeply($a, $a.''),       "don't compare refs like strings";
242ok !is_deeply([$a], [$a.'']),   "  even deep inside";
243
244
245#line 265
246# [rt.cpan.org 7030]
247ok !is_deeply( {}, {key => []} ),  '[] could match non-existent values';
248ok !is_deeply( [], [[]] );
249
250
251#line 273
252$$err = $$out = '';
253ok !is_deeply( [\'a', 'b'], [\'a', 'c'] );
254is( $out, "not ok 20\n",  'scalar refs in an array' );
255is( $err, <<ERR,        '    right diagnostic' );
256#   Failed test at $0 line 274.
257#     Structures begin differing at:
258#          \$got->[1] = 'b'
259#     \$expected->[1] = 'c'
260ERR
261
262
263#line 285
264my $ref = \23;
265ok !is_deeply( 23, $ref );
266is( $out, "not ok 21\n", 'scalar vs ref' );
267is( $err, <<ERR,        '  right diagnostic');
268#   Failed test at $0 line 286.
269#     Structures begin differing at:
270#          \$got = '23'
271#     \$expected = $ref
272ERR
273
274#line 296
275ok !is_deeply( $ref, 23 );
276is( $out, "not ok 22\n", 'ref vs scalar' );
277is( $err, <<ERR,        '  right diagnostic');
278#   Failed test at $0 line 296.
279#     Structures begin differing at:
280#          \$got = $ref
281#     \$expected = '23'
282ERR
283
284#line 306
285ok !is_deeply( undef, [] );
286is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
287like( $err, <<ERR,	 '  right diagnostic' );
288#   Failed test at $Filename line 306\\.
289#     Structures begin differing at:
290#          \\\$got = undef
291#     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
292ERR
293
294
295# rt.cpan.org 8865
296{
297    my $array = [];
298    my $hash  = {};
299
300#line 321
301    ok !is_deeply( $array, $hash );
302    is( $out, "not ok 24\n", 'is_deeply and different reference types' );
303    is( $err, <<ERR, 	     '  right diagnostic' );
304#   Failed test at $0 line 321.
305#     Structures begin differing at:
306#          \$got = $array
307#     \$expected = $hash
308ERR
309
310#line 332
311    ok !is_deeply( [$array], [$hash] );
312    is( $out, "not ok 25\n", 'nested different ref types' );
313    is( $err, <<ERR,	     '  right diagnostic' );
314#   Failed test at $0 line 332.
315#     Structures begin differing at:
316#          \$got->[0] = $array
317#     \$expected->[0] = $hash
318ERR
319
320
321    # Overloaded object tests
322    {
323	my $foo = bless [], "Foo";
324	my $bar = bless {}, "Bar";
325
326	{
327	    package Bar;
328	    "overload"->import(q[""] => sub { "wibble" });
329	}
330
331#line 353
332	ok !is_deeply( [$foo], [$bar] );
333	is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
334	is( $err, <<ERR,	     '  right diagnostic' );
335#   Failed test at $0 line 353.
336#     Structures begin differing at:
337#          \$got->[0] = $foo
338#     \$expected->[0] = 'wibble'
339ERR
340
341    }
342}
343
344
345# rt.cpan.org 14746
346{
347# line 349
348    ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
349    is( $out, "not ok 27\n" );
350    like( $err, <<ERR,	     '  right diagnostic' );
351#   Failed test at $Filename line 349.
352#     Structures begin differing at:
353#          \\\$got = CODE\\(0x[0-9a-f]+\\)
354#     \\\$expected = CODE\\(0x[0-9a-f]+\\)
355ERR
356
357
358    use Symbol;
359    my $glob1 = gensym;
360    my $glob2 = gensym;
361
362#line 357
363    ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
364    is( $out, "not ok 28\n" );
365    like( $err, <<ERR,	     '  right diagnostic' );
366#   Failed test at $Filename line 357.
367#     Structures begin differing at:
368#          \\\$got = GLOB\\(0x[0-9a-f]+\\)
369#     \\\$expected = GLOB\\(0x[0-9a-f]+\\)
370ERR
371
372}
373
374
375# rt.cpan.org 53469
376{
377
378    # Accept both old and new-style stringification
379    my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '^' : '-xism';
380#line 380
381    ok !is_deeply( qr/a/, qr/b/, "different regexes" );
382    is( $out, "not ok 29 - different regexes\n" );
383    is( $err, <<ERR,          '  right diagnostic' );
384#   Failed test 'different regexes'
385#   at $0 line 380.
386#     Structures begin differing at:
387#          \$got = (?$modifiers:a)
388#     \$expected = (?$modifiers:b)
389ERR
390}
391
392
393# false values that should not compare equal
394{
395    ok !is_deeply( 0, '', "0 != ''" );
396    is( $out, "not ok 30 - 0 != ''\n" );
397    ok !is_deeply( 0, undef, "0 != undef" );
398    is( $out,    "not ok 31 - 0 != undef\n" );
399    ok !is_deeply( '', undef, "'' != undef" );
400    is( $out,     "not ok 32 - '' != undef\n" );
401
402    ok !is_deeply( [0], [''], "[0] != ['']" );
403    is( $out,     "not ok 33 - [0] != ['']\n" );
404    ok !is_deeply( [0], [undef], "[0] != [undef]" );
405    is( $out,        "not ok 34 - [0] != [undef]\n" );
406    ok !is_deeply( [''], [undef], "[''] != [undef]" );
407    is( $out,         "not ok 35 - [''] != [undef]\n" );
408
409    ok !is_deeply( [0], [], "[0] != []" );
410    is( $out,   "not ok 36 - [0] != []\n" );
411    ok !is_deeply( [undef], [], "[undef] != []" );
412    is( $out,       "not ok 37 - [undef] != []\n" );
413    ok !is_deeply( [''], [], "[''] != []" );
414    is( $out,    "not ok 38 - [''] != []\n" );
415
416    ok !is_deeply( {x => 0}, {x => ''}, "{x => 0} != {x => ''}" );
417    is( $out,               "not ok 39 - {x => 0} != {x => ''}\n" );
418    ok !is_deeply( {x => 0}, {x => undef}, "{x => 0} != {x => undef}" );
419    is( $out,                  "not ok 40 - {x => 0} != {x => undef}\n" );
420    ok !is_deeply( {x => ''}, {x => undef}, "{x => ''} != {x => undef}" );
421    is( $out,                   "not ok 41 - {x => ''} != {x => undef}\n" );
422}
423
424# this will also happily fail before 5.10, even though there's no VSTRING ref type
425{
426    my $version1 = v1.2.3;
427    my $version2 = v1.2.4;
428    ok !is_deeply( [\\$version1], [\\$version2], "version objects");
429    is( $out, "not ok 42 - version objects\n" );
430}
431
432{
433    my $version1 = v1.2.3;
434    my $version2 = '' . v1.2.3;
435    ok is_deeply( [\$version1], [\$version2], "version objects");
436    is( $out, "ok 43 - version objects\n" );
437}
438
439{
440    my $version1 = v1.2.3;
441    my $version2 = v1.2.3;
442    ok !is_deeply( [$version1], [\$version2], "version objects");
443    is( $out, "not ok 44 - version objects\n" );
444}
445
446{
447    my $string = "abc";
448    my $string2 = "b";
449    ok is_deeply( [\substr($string, 1, 1)], [\$string2], "lvalue ref");
450    is( $out, "ok 45 - lvalue ref\n" );
451}
452
453{
454    my $string = "b";
455    my $string2 = "b";
456    ok !is_deeply( [\substr($string, 1, 1)], ["b"], "lvalue ref");
457    is( $out, "not ok 46 - lvalue ref\n" );
458}
459