[p5sagit/p5-mst-13.2.git] / lib / Test / Simple / t / is_deeply.t

#!/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;

print "1..34\n";

my $test_num = 1;
# Utility testing functions.
sub ok ($;$) {
    my($test, $name) = @_;
    my $ok = '';
    $ok .= "not " unless $test;
    $ok .= "ok $test_num";
    $ok .= " - $name" if defined $name;
    $ok .= "\n";
    print $ok;
    $test_num++;

    return $test;
}

sub is ($$;$) {
    my($this, $that, $name) = @_;
    my $test = $$this eq $that;
    my $ok = '';
    $ok .= "not " unless $test;
    $ok .= "ok $test_num";
    $ok .= " - $name" if defined $name;
    $ok .= "\n";
    print $ok;

    unless( $test ) {
        print "# got      \n$$this";
        print "# expected \n$that";
    }
    $test_num++;

    $$this = '';

    return $test;
}

sub like ($$;$) {
    my($this, $regex, $name) = @_;

    $regex = qr/$regex/ unless ref $regex;
    my $test = $$this =~ $regex;

    my $ok = '';
    $ok .= "not " unless $test;
    $ok .= "ok $test_num";
    $ok .= " - $name" if defined $name;
    $ok .= "\n";
    print $ok;

    unless( $test ) {
        print "# got      \n$$this";
        print "# expected \n$regex";
    }
    $test_num++;

    $$this = '';


    return $test;
}


require Test::More;
Test::More->import(tests => 11, import => ['is_deeply']);

my $Filename = quotemeta $0;

#line 68
is_deeply('foo', 'bar', 'plain strings');
is( $out, "not ok 1 - plain strings\n",     'plain strings' );
is( $err, <<ERR,                            '    right diagnostic' );
#     Failed test ($0 at line 68)
#          got: 'foo'
#     expected: 'bar'
ERR


#line 78
is_deeply({}, [], 'different types');
is( $out, "not ok 2 - different types\n",   'different types' );
like( $err, <<ERR,                          '   right diagnostic' );
#     Failed test \\($Filename at line 78\\)
#     Structures begin differing at:
#          \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
#     \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
ERR

#line 88
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 ($0 at line 88)
#     Structures begin differing at:
#          \$got->{this} = '42'
#     \$expected->{this} = '43'
ERR

#line 99
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 ($0 at line 99)
#     Structures begin differing at:
#          \$got->{this} = Does not exist
#     \$expected->{this} = '42'
ERR

#line 110
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 ($0 at line 110)
#     Structures begin differing at:
#          \$got->[9] = Does not exist
#     \$expected->[9] = '10'
ERR

#line 121
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 ($0 at line 121)
#     Structures begin differing at:
#          \$got->[1] = undef
#     \$expected->[1] = Does not exist
ERR

#line 131
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 ($0 at line 131)
#     Structures begin differing at:
#          \$got->{foo} = undef
#     \$expected->{foo} = Does not exist
ERR

#line 141
is_deeply(\42, \23,   'scalar refs');
is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
is( $err, <<ERR,                        '    right diagnostic' );
#     Failed test ($0 at line 141)
#     Structures begin differing at:
#     \${     \$got} = '42'
#     \${\$expected} = '23'
ERR

#line 151
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 \\($Filename at 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
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 ($0 at 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
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 ($0 at 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 '', @_; };
    is_deeply(@$test);

    like \$warning, 
         qr/^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 = '';
is_deeply( [\'a', 'b'], [\'a', 'c'] );
is( $out, "not ok 20\n",  'scalar refs in an array' );
is( $err, <<ERR,        '    right diagnostic' );
#     Failed test ($0 at line 274)
#     Structures begin differing at:
#          \$got->[1] = 'b'
#     \$expected->[1] = 'c'
ERR
Commit	Line	Data
a9153838	1	#!/usr/bin/perl -w
33459055	2
33459055	3	BEGIN {
a9153838	4	if( $ENV{PERL_CORE} ) {
	5	chdir 't';
	6	@INC = ('../lib', 'lib');
	7	}
	8	else {
	9	unshift @INC, 't/lib';
	10	}
33459055	11	}
	12
	13	use strict;
33459055	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);
30e302f8	20	local $ENV{HARNESS_ACTIVE} = 0;
30e302f8	21
33459055	22
	23	# Can't use Test.pm, that's a 5.005 thing.
	24	package main;
	25
7483b81c	26	print "1..34\n";
33459055	27
	28	my $test_num = 1;
	29	# Utility testing functions.
7483b81c	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
33459055	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) = @_;
7483b81c	66
30e302f8	67	$regex = qr/$regex/ unless ref $regex;
30e302f8	68	my $test = $$this =~ $regex;
33459055	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:
2f71ccc2	111	# \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
2f71ccc2	112	# \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
33459055	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
30e302f8	159	is_deeply({ foo => undef }, {}, 'hashes of undefs' );
33459055	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:
2f71ccc2	185	# \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)'
2f71ccc2	186	# \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)'
33459055	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' );
7483b81c	225	ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
33459055	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
30e302f8	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	}
7483b81c	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