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