diff -ur libtest-unit-perl-0.24.debian/lib/Test/Unit/Assert.pm libtest-unit-perl-0.24/lib/Test/Unit/Assert.pm --- libtest-unit-perl-0.24.debian/lib/Test/Unit/Assert.pm 2004-05-18 14:35:41.000000000 -0400 +++ libtest-unit-perl-0.24/lib/Test/Unit/Assert.pm 2004-05-18 15:09:53.000000000 -0400 @@ -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,23 +237,36 @@ } 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; my ($e1, $e2) = @_; - # Quiet uninitialized value warnings when comparing undefs. - local $^W = 0; + if ( ! defined $e1 || ! defined $e2 ) { + return 1 if !defined $e1 && !defined $e2; + push @Data_Stack, { vals => [$e1, $e2] }; + return 0; + } + + return 0 if ( (defined $e1 && $e1 eq $DNE) + || (defined $e2 && $e2 eq $DNE )); return 1 if $e1 eq $e2; + if ( ref $e1 && ref $e2 ) { + my $e2_ref = "$e2"; + return 1 if defined $Seen_Refs{$e1} && $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); } Only in libtest-unit-perl-0.24/lib/Test/Unit: Assert.pm~ diff -ur libtest-unit-perl-0.24.debian/t/tlib/AssertTest.pm libtest-unit-perl-0.24/t/tlib/AssertTest.pm --- libtest-unit-perl-0.24.debian/t/tlib/AssertTest.pm 2004-05-18 14:35:41.000000000 -0400 +++ libtest-unit-perl-0.24/t/tlib/AssertTest.pm 2004-05-18 15:07:56.000000000 -0400 @@ -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 @@ -381,6 +420,12 @@ 'Both arguments were not references' => [ '', 0 ], $differ->(qw/ARRAY HASH/) => [ [], {} ], $differ->(qw/ARRAY HASH/) => [ [1,2], {1,2} ], + $differ->( 'ARRAY', 'undef' ) => [ { 'test' => []}, + { 'test' => undef } ], + $differ->( 'ARRAY', 'not\ exist' ) => [ { 'test' => []}, {} ], + $differ->( 'undef', 'ARRAY' ) => [ { 'test' => undef }, + { 'test' => []} ], + $differ->( '', 'undef' ) => [ [ '' ], [ undef ] ], $differ->('not\ exist', "'3'") => [ [1,2], [1,2,3] ], $differ->("'3'", 'not\ exist') => [ [1,2,3], [1,2] ], $differ->("'wahhhhh'", "'wahhhh'") => [ @@ -398,6 +443,7 @@ }, } ], + $differ->( 'HASH', 'undef') => [ \%family, $bad_copy ], ); my @tests = (); Only in libtest-unit-perl-0.24/t/tlib: AssertTest.pm~