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;
package main;
my $TB = Test::Builder->create;
$TB->plan(tests => 73);
sub ok ($;$) {
return $TB->ok(@_);
}
sub is ($$;$) {
my($this, $that, $name) = @_;
my $ok = $TB->is_eq($$this, $that, $name);
$$this = '';
return $ok;
}
sub like ($$;$) {
my($this, $regex, $name) = @_;
$regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
my $ok = $TB->like($$this, $regex, $name);
$$this = '';
return $ok;
}
require Test::More;
Test::More->import(tests => 11, import => ['is_deeply']);
my $Filename = quotemeta $0;
ok !is_deeply('foo', 'bar', 'plain strings');
is( $out, "not ok 1 - plain strings\n", 'plain strings' );
is( $err, <<ERR, ' right diagnostic' );
ERR
ok !is_deeply({}, [], 'different types');
is( $out, "not ok 2 - different types\n", 'different types' );
like( $err, <<ERR, ' right diagnostic' );
ERR
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' );
ERR
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' );
ERR
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' );
ERR
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' );
ERR
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' );
ERR
ok !is_deeply(\42, \23, 'scalar refs');
is( $out, "not ok 8 - scalar refs\n", 'scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
ERR
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' );
ERR
my($a1, $a2, $a3);
$a1 = \$a2; $a2 = \$a3;
$a3 = 42;
my($b1, $b2, $b3);
$b1 = \$b2; $b2 = \$b3;
$b3 = 23;
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' );
ERR
my $foo = {
this => [1..10],
that => { up => "down", left => "right" },
};
my $bar = {
this => [1..10],
that => { up => "down", left => "right", foo => 42 },
};
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' );
ERR
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/";
}
ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
my $a = [];
ok !is_deeply($a, $a.''), "don't compare refs like strings";
ok !is_deeply([$a], [$a.'']), " even deep inside";
ok !is_deeply( {}, {key => []} ), '[] could match non-existent values';
ok !is_deeply( [], [[]] );
$$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' );
ERR
my $ref = \23;
ok !is_deeply( 23, $ref );
is( $out, "not ok 21\n", 'scalar vs ref' );
is( $err, <<ERR, ' right diagnostic');
ERR
ok !is_deeply( $ref, 23 );
is( $out, "not ok 22\n", 'ref vs scalar' );
is( $err, <<ERR, ' right diagnostic');
ERR
ok !is_deeply( undef, [] );
is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
like( $err, <<ERR, ' right diagnostic' );
ERR
{
my $array = [];
my $hash = {};
ok !is_deeply( $array, $hash );
is( $out, "not ok 24\n", 'is_deeply and different reference types' );
is( $err, <<ERR, ' right diagnostic' );
ERR
ok !is_deeply( [$array], [$hash] );
is( $out, "not ok 25\n", 'nested different ref types' );
is( $err, <<ERR, ' right diagnostic' );
ERR
{
my $foo = bless [], "Foo";
my $bar = bless {}, "Bar";
{
package Bar;
"overload"->import(q[""] => sub { "wibble" });
}
ok !is_deeply( [$foo], [$bar] );
is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
is( $err, <<ERR, ' right diagnostic' );
ERR
}
}
{
ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
is( $out, "not ok 27\n" );
like( $err, <<ERR, ' right diagnostic' );
ERR
use Symbol;
my $glob1 = gensym;
my $glob2 = gensym;
ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
is( $out, "not ok 28\n" );
like( $err, <<ERR, ' right diagnostic' );
ERR
}