[Perlunit-users] Patch to fix assert_deep_equals() on circular structures.

[Francis J. Lacoste]

Hello everyone,

(I'm sending this here, altough the mailing lists seems quite dormant
looking from the archives on SF.)

I'm using the perl unit framework in the Lire log analyser and we have
objects which have circular references. Unfortunately,
assert_deep_equals() will enter infinite recursion on such structure.

I'm attaching the a patch (apply using -p1) which fixes this. The patch
also adds the proper check to the AssertTest unit tests.

(This patch was also uploaded to the SF tracker).

-- 
Francis J. Lacoste
[EMAIL PROTECTED]

--- libtest-unit-perl-0.24.orig/lib/Test/Unit/Assert.pm
+++ libtest-unit-perl-0.24/lib/Test/Unit/Assert.pm
@@ -219,6 +219,7 @@
 }
 
 # Shamelessly pinched from Test::More and adapted to Test::Unit.
+our %Seen_Refs = ();
 our @Data_Stack;
 my $DNE = bless [], 'Does::Not::Exist';
 sub assert_deep_equals {
@@ -236,13 +237,14 @@
     }
 
     local @Data_Stack = ();
+    local %Seen_Refs = ();
     if (! $self->_deep_check($this, $that)) {
         Test::Unit::Failure->throw(
             -text => @_ ? join('', @_)
                         : $self->_format_stack(@Data_Stack)
         );
     }
-}    
+}
 
 sub _deep_check {
     my $self = shift;
@@ -252,6 +254,11 @@
     local $^W = 0; 
 
     return 1 if $e1 eq $e2;
+    if ( ref $e1 && ref $e2 ) {
+        my $e2_ref = "$e2";
+        return 1 if $Seen_Refs{$e1} eq $e2_ref;
+        $Seen_Refs{$e1} = $e2_ref;
+    }
 
     if (UNIVERSAL::isa($e1, 'ARRAY') and UNIVERSAL::isa($e2, 'ARRAY')) {
         return $self->_eq_array($e1, $e2);
--- libtest-unit-perl-0.24.orig/t/tlib/AssertTest.pm
+++ libtest-unit-perl-0.24/t/tlib/AssertTest.pm
@@ -11,6 +11,8 @@
 use Error qw/:try/;
 use Class::Inner;
 
+use Data::Dumper;
+
 use vars qw/@ISA/;
 @ISA = qw(Test::Unit::TestCase ExceptionChecker);
 
@@ -328,6 +330,19 @@
     $self->assert_not_null(10);
 }
 
+sub deep_clone {
+    my $x = $_[0];
+
+    no strict;
+
+    $Data::Dumper::Purity = 1;
+
+    eval Dumper( $x );
+
+    # Data::Dumper assigns to VAR1.
+    return $VAR1;
+}
+
 sub test_assert_deep_equals {
     my $self = shift;
 
@@ -366,6 +381,30 @@
         },
     );
 
+    my %family = ( john => { name => 'John Doe',
+                              spouse => undef,
+                              children => [],
+                           },
+                   jane => { name   => 'Jane Doe',
+                             spouse => undef,
+                             children => [],
+                           },
+                   baby => { name => 'Baby Doll',
+                             spouse => undef,
+                             children => [],
+                           },
+                 );
+    $family{john}{spouse} = $family{jane};
+    $family{jane}{spouse} = $family{john};
+    push @{$family{john}{children}}, $family{baby};
+    push @{$family{jane}{children}}, $family{baby};
+
+    my $copy = deep_clone( \%family );
+    $self->assert_deep_equals( \%family, $copy );
+
+    my $bad_copy = deep_clone( \%family );
+    $bad_copy->{jane}{spouse} = $bad_copy->{baby};
+
     my $differ = sub {
         my ($a, $b) = @_;
         qr/^Structures\ begin\ differing\ at: $ \n
@@ -398,6 +437,7 @@
                  },
              }
          ],
+         $differ->( 'HASH', 'not\ exist') => [ \%family, $bad_copy ],
     );
 
     my @tests = ();

signature.asc
Description: This is a digitally signed message part