One more Test::More problem

[Fergal Daly]

Final one tonight!

eq_array and eq_hash don't tidy up after themselves. You would have to be very 
unfortunate to be stung by this problem but potentially you could end up with 
extra references to some of your variables which could effect tests further 
on due to DESTROYs not being called or whatever.

use Test::More;
for(1..10)
{
  eq_array( [[]], [{}] )
}
print join(", ", @Test::More::Data_Stack)."\n";

The solution is to make eq_array and eq_hash wrappers around the original 
functions. This is needed for the circular structures patch anyway.

Actually, I've gone a little further and made them wrappers around a new 
eq_deeply(). All they do is check that the second argument is of the correct 
type. This means that all the localling of @Data_Stack is only done in 
eq_deeply.

It also means they won't die anymore if the wrong kind of arguments are passed 
in. Although, I'm not sure if this is a good idea, maybe dying is preferable.

Patch attached.

Also attached is a test script that exercises the various comparison 
functions. It's missing a few cases but it covers a fair bit,

F

-- 
Do you need someone with lots of Unix sysadmin and/or lots of OO software 
development experience? Go on, giz a job.
My CV - http://www.fergaldaly.com/cv.html

--- lib/Test/More.pm.orig	2003-02-27 20:54:34.000000000 +0000
+++ lib/Test/More.pm	2003-02-28 00:11:47.000000000 +0000
@@ -25,7 +25,7 @@
              cmp_ok
              skip todo todo_skip
              pass fail
-             eq_array eq_hash eq_set
+             eq_array eq_hash eq_set eq_deeply
              $TODO
              plan
              can_ok  isa_ok
@@ -996,6 +996,12 @@
     return $out;
 }
 
+sub eq_deeply {
+    my ($a1, $a2) = @_;
+
+    local @Data_Stack = ();
+    return _deep_check($a1, $a2);
+}
 
 =item B<eq_array>
 
@@ -1007,7 +1013,14 @@
 =cut
 
 #'#
-sub eq_array  {
+
+sub eq_array {
+    my ($a1, $a2) = @_;
+
+    return UNIVERSAL::isa($a2, "ARRAY") ? return eq_deeply($a1, $a2) : 0;
+}
+
+sub _eq_array  {
     my($a1, $a2) = @_;
     return 1 if !ref $a1 and ! ref $a2 and $a1 eq $a2;
 
@@ -1042,12 +1055,12 @@
             if( UNIVERSAL::isa($e1, 'ARRAY') and
                 UNIVERSAL::isa($e2, 'ARRAY') )
             {
-                $ok = eq_array($e1, $e2);
+                $ok = _eq_array($e1, $e2);
             }
             elsif( UNIVERSAL::isa($e1, 'HASH') and
                    UNIVERSAL::isa($e2, 'HASH') )
             {
-                $ok = eq_hash($e1, $e2);
+                $ok = _eq_hash($e1, $e2);
             }
             elsif( UNIVERSAL::isa($e1, 'REF') and
                    UNIVERSAL::isa($e2, 'REF') )
@@ -1084,6 +1097,12 @@
 =cut
 
 sub eq_hash {
+    my ($a1, $a2) = @_;
+
+    return UNIVERSAL::isa($a2, "HASH") ? return eq_deeply($a1, $a2) : 0;
+}
+
+sub _eq_hash {
     my($a1, $a2) = @_;
     return 1 if !ref $a1 and ! ref $a2 and $a1 eq $a2;
 

# -*-perl-*-
use strict;
use Test::More (tests => 18);

{
	my $a = [];
	my $b = $a."";

	ok(! eq_deeply([$a], [$b]), "stringified");
}

{
	# take an array full of a variety of things and break each one

	my @a1 = an_array();
	my @a2 = an_array();

	is_deeply([EMAIL PROTECTED], [EMAIL PROTECTED], "is array");
	ok(eq_array([EMAIL PROTECTED], [EMAIL PROTECTED]), "eq array");

	for (my $i = 0; $i < @a1; $i++)
	{
		my @new = an_array();
		my $it = $new[$i];
		my $broken = break_it($it);

		$new[$i] = $broken;
		ok(! eq_array([EMAIL PROTECTED], [EMAIL PROTECTED]), "array broken ref='".ref($broken)."'");
	}

	my @new = an_array();
	break_it([EMAIL PROTECTED]);
	ok(! eq_array([EMAIL PROTECTED], [EMAIL PROTECTED]), "array broken extra");
}

{
	# take a hash full of a variety of things and break each one

	my %a1 = a_hash();
	my %a2 = a_hash();

	is_deeply(\%a1, \%a2, "is hash");
	ok(eq_hash(\%a1, \%a2), "eq hash");

	foreach my $key (keys %a1)
	{
		my %new = a_hash();
		my $it = $new{$key};
		my $broken = break_it($it);

		$new{$key} = $broken;
		ok(! eq_hash(\%new, \%a1), "hash broken ref='".ref($broken)."'");
	}

	my %new = a_hash();
	break_it(\%new);
	ok(! eq_hash(\%new, \%a1), "hash broken extra");
}

# test a messy complex thing
is_deeply(complex_thing(), complex_thing(), "complex");

sub an_array
{
	return ( [], {}, "hello", \"ref", \['hello'] );
}

sub a_hash
{
	return (
		key1 => [],
		key2 => {},
		key3 => "hello",
		key4 => \"ref",
		key5  => \['hello']
	);
}

sub break_it
{
	my $it = shift;

	if (UNIVERSAL::isa($it, 'ARRAY'))
	{
		push(@$it, "extra elem");
	}
	elsif (UNIVERSAL::isa($it, 'HASH'))
	{
		$it->{"extra key"} = "extra value";
	}
	elsif (UNIVERSAL::isa($it, 'REF'))
	{
		$it = \['a different ref'];
	}
	elsif (UNIVERSAL::isa($it, 'SCALAR'))
	{
		$it = \"$$it and something else";
	}
	else
	{
		$it = "$it something else";
	}
	return $it
}

sub complex_thing
{
	my $b = [qw( hello world)];
	my $a = [
		{
			key1 => \$b,
			key2 => [{}],
			key3 => \'scalarref',
			key4 => 'scalar',
		},
		[\"scalarref"],
	];

	return $a;
}