lib/Test/Simple/t/is_deeply.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 print "1..38\n";
  27
  28 my $test_num = 1;
  29 # Utility testing functions.
  30 sub ok ($;$) {
  31     my($test, $name) = @_;
  32     my $ok = '';
  33     $ok .= "not " unless $test;
  34     $ok .= "ok $test_num";
  35     $ok .= " - $name" if defined $name;
  36     $ok .= "\n";
  37     print $ok;
  38     $test_num++;
  39
  40     return $test;
  41 }
  42
  43 sub is ($$;$) {
  44     my($this, $that, $name) = @_;
  45     my $test = $$this eq $that;
  46     my $ok = '';
  47     $ok .= "not " unless $test;
  48     $ok .= "ok $test_num";
  49     $ok .= " - $name" if defined $name;
  50     $ok .= "\n";
  51     print $ok;
  52
  53     unless( $test ) {
  54         print "# got      \n$$this";
  55         print "# expected \n$that";
  56     }
  57     $test_num++;
  58
  59     $$this = '';
  60
  61     return $test;
  62 }
  63
  64 sub like ($$;$) {
  65     my($this, $regex, $name) = @_;
  66
  67     $regex = qr/$regex/ unless ref $regex;
  68     my $test = $$this =~ $regex;
  69
  70     my $ok = '';
  71     $ok .= "not " unless $test;
  72     $ok .= "ok $test_num";
  73     $ok .= " - $name" if defined $name;
  74     $ok .= "\n";
  75     print $ok;
  76
  77     unless( $test ) {
  78         print "# got      \n$$this";
  79         print "# expected \n$regex";
  80     }
  81     $test_num++;
  82
  83     $$this = '';
  84
  85
  86     return $test;
  87 }
  88
  89
  90 require Test::More;
  91 Test::More->import(tests => 11, import => ['is_deeply']);
  92
  93 my $Filename = quotemeta $0;
  94
  95 #line 68
  96 is_deeply('foo', 'bar', 'plain strings');
  97 is( $out, "not ok 1 - plain strings\n",     'plain strings' );
  98 is( $err, <<ERR,                            '    right diagnostic' );
  99 #     Failed test ($0 at line 68)
 100 #          got: 'foo'
 101 #     expected: 'bar'
 102 ERR
 103
 104
 105 #line 78
 106 is_deeply({}, [], 'different types');
 107 is( $out, "not ok 2 - different types\n",   'different types' );
 108 like( $err, <<ERR,                          '   right diagnostic' );
 109 #     Failed test \\($Filename at line 78\\)
 110 #     Structures begin differing at:
 111 #          \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
 112 #     \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
 113 ERR
 114
 115 #line 88
 116 is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
 117 is( $out, "not ok 3 - hashes with different values\n",
 118                                         'hashes with different values' );
 119 is( $err, <<ERR,                        '   right diagnostic' );
 120 #     Failed test ($0 at line 88)
 121 #     Structures begin differing at:
 122 #          \$got->{this} = '42'
 123 #     \$expected->{this} = '43'
 124 ERR
 125
 126 #line 99
 127 is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
 128 is( $out, "not ok 4 - hashes with different keys\n",
 129                                         'hashes with different keys' );
 130 is( $err, <<ERR,                        '    right diagnostic' );
 131 #     Failed test ($0 at line 99)
 132 #     Structures begin differing at:
 133 #          \$got->{this} = Does not exist
 134 #     \$expected->{this} = '42'
 135 ERR
 136
 137 #line 110
 138 is_deeply([1..9], [1..10],    'arrays of different length');
 139 is( $out, "not ok 5 - arrays of different length\n",
 140                                         'arrays of different length' );
 141 is( $err, <<ERR,                        '    right diagnostic' );
 142 #     Failed test ($0 at line 110)
 143 #     Structures begin differing at:
 144 #          \$got->[9] = Does not exist
 145 #     \$expected->[9] = '10'
 146 ERR
 147
 148 #line 121
 149 is_deeply([undef, undef], [undef], 'arrays of undefs' );
 150 is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
 151 is( $err, <<ERR,                            '    right diagnostic' );
 152 #     Failed test ($0 at line 121)
 153 #     Structures begin differing at:
 154 #          \$got->[1] = undef
 155 #     \$expected->[1] = Does not exist
 156 ERR
 157
 158 #line 131
 159 is_deeply({ foo => undef }, {},    'hashes of undefs' );
 160 is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
 161 is( $err, <<ERR,                            '    right diagnostic' );
 162 #     Failed test ($0 at line 131)
 163 #     Structures begin differing at:
 164 #          \$got->{foo} = undef
 165 #     \$expected->{foo} = Does not exist
 166 ERR
 167
 168 #line 141
 169 is_deeply(\42, \23,   'scalar refs');
 170 is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
 171 is( $err, <<ERR,                        '    right diagnostic' );
 172 #     Failed test ($0 at line 141)
 173 #     Structures begin differing at:
 174 #     \${     \$got} = '42'
 175 #     \${\$expected} = '23'
 176 ERR
 177
 178 #line 151
 179 is_deeply([], \23,    'mixed scalar and array refs');
 180 is( $out, "not ok 9 - mixed scalar and array refs\n",
 181                                         'mixed scalar and array refs' );
 182 like( $err, <<ERR,                      '    right diagnostic' );
 183 #     Failed test \\($Filename at line 151\\)
 184 #     Structures begin differing at:
 185 #          \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)'
 186 #     \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)'
 187 ERR
 188
 189
 190 my($a1, $a2, $a3);
 191 $a1 = \$a2;  $a2 = \$a3;
 192 $a3 = 42;
 193
 194 my($b1, $b2, $b3);
 195 $b1 = \$b2;  $b2 = \$b3;
 196 $b3 = 23;
 197
 198 #line 173
 199 is_deeply($a1, $b1, 'deep scalar refs');
 200 is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
 201 is( $err, <<ERR,                              '    right diagnostic' );
 202 #     Failed test ($0 at line 173)
 203 #     Structures begin differing at:
 204 #     \${\${     \$got}} = '42'
 205 #     \${\${\$expected}} = '23'
 206 ERR
 207
 208 # I don't know how to properly display this structure.
 209 # $a2 = { foo => \$a3 };
 210 # $b2 = { foo => \$b3 };
 211 # is_deeply([$a1], [$b1], 'deep mixed scalar refs');
 212
 213 my $foo = {
 214            this => [1..10],
 215            that => { up => "down", left => "right" },
 216           };
 217
 218 my $bar = {
 219            this => [1..10],
 220            that => { up => "down", left => "right", foo => 42 },
 221           };
 222
 223 #line 198
 224 is_deeply( $foo, $bar, 'deep structures' );
 225 ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
 226 is( $out, "not ok 11 - deep structures\n",  'deep structures' );
 227 is( $err, <<ERR,                            '    right diagnostic' );
 228 #     Failed test ($0 at line 198)
 229 #     Structures begin differing at:
 230 #          \$got->{that}{foo} = Does not exist
 231 #     \$expected->{that}{foo} = '42'
 232 ERR
 233
 234
 235 #line 221
 236 my @tests = ([],
 237              [qw(42)],
 238              [qw(42 23), qw(42 23)]
 239             );
 240
 241 foreach my $test (@tests) {
 242     my $num_args = @$test;
 243
 244     my $warning;
 245     local $SIG{__WARN__} = sub { $warning .= join '', @_; };
 246     is_deeply(@$test);
 247
 248     like \$warning,
 249          qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/;
 250 }
 251
 252
 253 #line 240
 254 # [rt.cpan.org 6837]
 255 ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
 256 ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
 257
 258
 259 #line 258
 260 # [rt.cpan.org 7031]
 261 my $a = [];
 262 ok !is_deeply($a, $a.''),       "don't compare refs like strings";
 263 ok !is_deeply([$a], [$a.'']),   "  even deep inside";
 264
 265
 266 #line 265
 267 # [rt.cpan.org 7030]
 268 ok !is_deeply( {}, {key => []} ),  '[] could match non-existent values';
 269 ok !is_deeply( [], [[]] );
 270
 271
 272 #line 273
 273 $$err = $$out = '';
 274 is_deeply( [\'a', 'b'], [\'a', 'c'] );
 275 is( $out, "not ok 20\n",  'scalar refs in an array' );
 276 is( $err, <<ERR,        '    right diagnostic' );
 277 #     Failed test ($0 at line 274)
 278 #     Structures begin differing at:
 279 #          \$got->[1] = 'b'
 280 #     \$expected->[1] = 'c'
 281 ERR
 282
 283
 284 #line 285
 285 my $ref = \23;
 286 is_deeply( 23, $ref );
 287 is( $out, "not ok 21\n", 'scalar vs ref' );
 288 is( $err, <<ERR,        '  right diagnostic');
 289 #     Failed test ($0 at line 286)
 290 #     Structures begin differing at:
 291 #          \$got = '23'
 292 #     \$expected = '$ref'
 293 ERR
 294
 295 #line 296
 296 is_deeply( $ref, 23 );
 297 is( $out, "not ok 22\n", 'ref vs scalar' );
 298 is( $err, <<ERR,        '  right diagnostic');
 299 #     Failed test ($0 at line 296)
 300 #     Structures begin differing at:
 301 #          \$got = '$ref'
 302 #     \$expected = '23'
 303 ERR