lib/Test/Simple/t/is_deeply_fail.t

   1 #!/usr/bin/perl -w
   2 # $Id: /mirror/googlecode/test-more/t/is_deeply_fail.t 57943 2008-08-18T02:09:22.275428Z brooklyn.kid51  $
   3
   4 BEGIN {
   5     if( $ENV{PERL_CORE} ) {
   6         chdir 't';
   7         @INC = ('../lib', 'lib');
   8     }
   9     else {
  10         unshift @INC, 't/lib';
  11     }
  12 }
  13
  14 use strict;
  15
  16 use Test::Builder;
  17 require Test::Simple::Catch;
  18 my($out, $err) = Test::Simple::Catch::caught();
  19 Test::Builder->new->no_header(1);
  20 Test::Builder->new->no_ending(1);
  21 local $ENV{HARNESS_ACTIVE} = 0;
  22
  23
  24 # Can't use Test.pm, that's a 5.005 thing.
  25 package main;
  26
  27
  28 my $TB = Test::Builder->create;
  29 $TB->plan(tests => 73);
  30
  31 # Utility testing functions.
  32 sub ok ($;$) {
  33     return $TB->ok(@_);
  34 }
  35
  36 sub is ($$;$) {
  37     my($this, $that, $name) = @_;
  38
  39     my $ok = $TB->is_eq($$this, $that, $name);
  40
  41     $$this = '';
  42
  43     return $ok;
  44 }
  45
  46 sub like ($$;$) {
  47     my($this, $regex, $name) = @_;
  48     $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
  49
  50     my $ok = $TB->like($$this, $regex, $name);
  51
  52     $$this = '';
  53
  54     return $ok;
  55 }
  56
  57
  58 require Test::More;
  59 Test::More->import(tests => 11, import => ['is_deeply']);
  60
  61 my $Filename = quotemeta $0;
  62
  63 #line 68
  64 ok !is_deeply('foo', 'bar', 'plain strings');
  65 is( $out, "not ok 1 - plain strings\n",     'plain strings' );
  66 is( $err, <<ERR,                            '    right diagnostic' );
  67 #   Failed test 'plain strings'
  68 #   at $0 line 68.
  69 #          got: 'foo'
  70 #     expected: 'bar'
  71 ERR
  72
  73
  74 #line 78
  75 ok !is_deeply({}, [], 'different types');
  76 is( $out, "not ok 2 - different types\n",   'different types' );
  77 like( $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]+\\)
  83 ERR
  84
  85 #line 88
  86 ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
  87 is( $out, "not ok 3 - hashes with different values\n",
  88                                         'hashes with different values' );
  89 is( $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'
  95 ERR
  96
  97 #line 99
  98 ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
  99 is( $out, "not ok 4 - hashes with different keys\n",
 100                                         'hashes with different keys' );
 101 is( $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'
 107 ERR
 108
 109 #line 110
 110 ok !is_deeply([1..9], [1..10],    'arrays of different length');
 111 is( $out, "not ok 5 - arrays of different length\n",
 112                                         'arrays of different length' );
 113 is( $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'
 119 ERR
 120
 121 #line 121
 122 ok !is_deeply([undef, undef], [undef], 'arrays of undefs' );
 123 is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
 124 is( $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
 130 ERR
 131
 132 #line 131
 133 ok !is_deeply({ foo => undef }, {},    'hashes of undefs' );
 134 is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
 135 is( $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
 141 ERR
 142
 143 #line 141
 144 ok !is_deeply(\42, \23,   'scalar refs');
 145 is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
 146 is( $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'
 152 ERR
 153
 154 #line 151
 155 ok !is_deeply([], \23,    'mixed scalar and array refs');
 156 is( $out, "not ok 9 - mixed scalar and array refs\n",
 157                                         'mixed scalar and array refs' );
 158 like( $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]+\\)
 164 ERR
 165
 166
 167 my($a1, $a2, $a3);
 168 $a1 = \$a2;  $a2 = \$a3;
 169 $a3 = 42;
 170
 171 my($b1, $b2, $b3);
 172 $b1 = \$b2;  $b2 = \$b3;
 173 $b3 = 23;
 174
 175 #line 173
 176 ok !is_deeply($a1, $b1, 'deep scalar refs');
 177 is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
 178 is( $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'
 184 ERR
 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
 191 my $foo = {
 192            this => [1..10],
 193            that => { up => "down", left => "right" },
 194           };
 195
 196 my $bar = {
 197            this => [1..10],
 198            that => { up => "down", left => "right", foo => 42 },
 199           };
 200
 201 #line 198
 202 ok !is_deeply( $foo, $bar, 'deep structures' );
 203 ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
 204 is( $out, "not ok 11 - deep structures\n",  'deep structures' );
 205 is( $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'
 211 ERR
 212
 213
 214 #line 221
 215 my @tests = ([],
 216              [qw(42)],
 217              [qw(42 23), qw(42 23)]
 218             );
 219
 220 foreach 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]
 234 ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
 235 ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
 236
 237
 238 #line 258
 239 # [rt.cpan.org 7031]
 240 my $a = [];
 241 ok !is_deeply($a, $a.''),       "don't compare refs like strings";
 242 ok !is_deeply([$a], [$a.'']),   "  even deep inside";
 243
 244
 245 #line 265
 246 # [rt.cpan.org 7030]
 247 ok !is_deeply( {}, {key => []} ),  '[] could match non-existent values';
 248 ok !is_deeply( [], [[]] );
 249
 250
 251 #line 273
 252 $$err = $$out = '';
 253 ok !is_deeply( [\'a', 'b'], [\'a', 'c'] );
 254 is( $out, "not ok 20\n",  'scalar refs in an array' );
 255 is( $err, <<ERR,        '    right diagnostic' );
 256 #   Failed test at $0 line 274.
 257 #     Structures begin differing at:
 258 #          \$got->[1] = 'b'
 259 #     \$expected->[1] = 'c'
 260 ERR
 261
 262
 263 #line 285
 264 my $ref = \23;
 265 ok !is_deeply( 23, $ref );
 266 is( $out, "not ok 21\n", 'scalar vs ref' );
 267 is( $err, <<ERR,        '  right diagnostic');
 268 #   Failed test at $0 line 286.
 269 #     Structures begin differing at:
 270 #          \$got = '23'
 271 #     \$expected = $ref
 272 ERR
 273
 274 #line 296
 275 ok !is_deeply( $ref, 23 );
 276 is( $out, "not ok 22\n", 'ref vs scalar' );
 277 is( $err, <<ERR,        '  right diagnostic');
 278 #   Failed test at $0 line 296.
 279 #     Structures begin differing at:
 280 #          \$got = $ref
 281 #     \$expected = '23'
 282 ERR
 283
 284 #line 306
 285 ok !is_deeply( undef, [] );
 286 is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
 287 like( $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]+\\)
 292 ERR
 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
 308 ERR
 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
 318 ERR
 319
 320
 321     if( eval { require overload } ) {
 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     else {
 342         $TB->skip("Needs overload.pm") for 1..3;
 343     }
 344 }
 345
 346
 347 # rt.cpan.org 14746
 348 {
 349 # line 349
 350     ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
 351     is( $out, "not ok 27\n" );
 352     like( $err, <<ERR,       '  right diagnostic' );
 353 #   Failed test at $Filename line 349.
 354 #     Structures begin differing at:
 355 #          \\\$got = CODE\\(0x[0-9a-f]+\\)
 356 #     \\\$expected = CODE\\(0x[0-9a-f]+\\)
 357 ERR
 358
 359
 360     use Symbol;
 361     my $glob1 = gensym;
 362     my $glob2 = gensym;
 363
 364 #line 357
 365     ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
 366     is( $out, "not ok 28\n" );
 367     like( $err, <<ERR,       '  right diagnostic' );
 368 #   Failed test at $Filename line 357.
 369 #     Structures begin differing at:
 370 #          \\\$got = GLOB\\(0x[0-9a-f]+\\)
 371 #     \\\$expected = GLOB\\(0x[0-9a-f]+\\)
 372 ERR
 373
 374 }