| Subject: | [PATCH] handle self-referential data structures |
When comparing two equivalent self-referential data structures, the deep comparison functions in Test::More loop forever, e.g.
my $a1 = [1, 2, 3];
push @$a1, $a1;
my $a2 = [1, 2, 3];
push @$a2, $a2;
is_deeply( $a1, $a2, 'foo' );
diff -Nurd Test-Simple-0.48_02.orig/lib/Test/More.pm Test-Simple-0.48_02/lib/Test/More.pm
--- Test-Simple-0.48_02.orig/lib/Test/More.pm Mon Jul 19 08:11:49 2004
+++ Test-Simple-0.48_02/lib/Test/More.pm Sat Aug 7 17:38:59 2004
@@ -969,7 +969,7 @@
=cut
-use vars qw(@Data_Stack);
+use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
sub is_deeply {
unless( @_ == 2 or @_ == 3 ) {
@@ -991,6 +991,7 @@
}
else {
local @Data_Stack = ();
+ local %Refs_Seen = ();
if( _deep_check($this, $that) ) {
$ok = $Test->ok(1, $name);
}
@@ -1055,9 +1056,20 @@
=cut
#'#
-sub eq_array {
+sub eq_array {
+ local %Refs_Seen;
+ _eq_array(@_);
+}
+
+sub _eq_array {
my($a1, $a2) = @_;
return 1 if $a1 eq $a2;
+ if ($Refs_Seen{$a1}) {
+ return $Refs_Seen{$a1} eq $a2;
+ }
+ else {
+ $Refs_Seen{$a1} = "$a2";
+ }
my $ok = 1;
my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
@@ -1071,6 +1083,7 @@
last unless $ok;
}
+
return $ok;
}
@@ -1090,12 +1103,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') )
@@ -1131,8 +1144,19 @@
=cut
sub eq_hash {
+ local %Refs_Seen;
+ _eq_hash(@_);
+}
+
+sub _eq_hash {
my($a1, $a2) = @_;
return 1 if $a1 eq $a2;
+ if ($Refs_Seen{$a1}) {
+ return $Refs_Seen{$a1} eq $a2;
+ }
+ else {
+ $Refs_Seen{$a1} = "$a2";
+ }
my $ok = 1;
my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
diff -Nurd Test-Simple-0.48_02.orig/t/refcycle.t Test-Simple-0.48_02/t/refcycle.t
--- Test-Simple-0.48_02.orig/t/refcycle.t Thu Jan 1 02:00:00 1970
+++ Test-Simple-0.48_02/t/refcycle.t Sat Aug 7 17:40:26 2004
@@ -0,0 +1,32 @@
+#!perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+use strict;
+use Test::More;
+
+plan tests => 3;
+
+my $a1 = [ 1, 2, 3 ];
+push @$a1, $a1;
+my $a2 = [ 1, 2, 3 ];
+push @$a2, $a2;
+
+ok( eq_array ($a1, $a2) );
+ok( eq_set ($a1, $a2) );
+
+my $h1 = { 1=>1, 2=>2, 3=>3 };
+$h1->{4} = $h1;
+my $h2 = { 1=>1, 2=>2, 3=>3 };
+$h2->{4} = $h2;
+
+ok( eq_hash ($h1, $h2) );