cpan/Test-Simple/t/is_deeply_fail.t

   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;
  28 $TB->plan(tests => 100);
  29
  30 # Utility testing functions.
  31 sub ok ($;$) {
  32     return $TB->ok(@_);
  33 }
  34
  35 sub 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
  45 sub 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
  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' );
  66 #   Failed test 'plain strings'
  67 #   at $0 line 68.
  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' );
  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]+\\)
  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' );
  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'
  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' );
 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'
 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' );
 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'
 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' );
 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
 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' );
 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
 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' );
 146 #   Failed test 'scalar refs'
 147 #   at $0 line 141.
 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' );
 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]+\\)
 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' );
 178 #   Failed test 'deep scalar refs'
 179 #   at $0 line 173.
 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' );
 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'
 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,
 227          "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
 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' );
 255 #   Failed test at $0 line 274.
 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');
 267 #   Failed test at $0 line 286.
 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');
 277 #   Failed test at $0 line 296.
 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' );
 287 #   Failed test at $Filename line 306\\.
 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' );
 303 #   Failed test at $0 line 321.
 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' );
 313 #   Failed test at $0 line 332.
 314 #     Structures begin differing at:
 315 #          \$got->[0] = $array
 316 #     \$expected->[0] = $hash
 317 ERR
 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'
 338 ERR
 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]+\\)
 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' );
 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]+\\)
 369 ERR
 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)
 388 ERR
 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 }