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