From: Vincent Pit Date: Tue, 28 Dec 2010 16:45:39 +0000 (+0100) Subject: Prevent vivification of deleted elements by fetching the array values X-Git-Tag: v0.01~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=0db3dd7d4fcdcb1161ed596c1582206245e81cca;p=perl%2Fmodules%2FTest-Leaner.git Prevent vivification of deleted elements by fetching the array values --- diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm index 8a41e4e..3980b43 100644 --- a/lib/Test/Leaner.pm +++ b/lib/Test/Leaner.pm @@ -491,7 +491,9 @@ sub _deep_check { if ($ry eq 'ARRAY') { if ($#$x == $#$y) { - _deep_check($x->[$_], $y->[$_]) or return 0 for 0 .. $#$y; + # Prevent vivification of deleted elements by fetching the array values. + my ($ex, $ey); + _deep_check($ex = $x->[$_], $ey = $y->[$_]) or return 0 for 0 .. $#$x; return 1; } } elsif ($ry eq 'HASH') { diff --git a/t/26-is_deeply.t b/t/26-is_deeply.t index 0d6b84c..d455040 100644 --- a/t/26-is_deeply.t +++ b/t/26-is_deeply.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::Leaner tests => 21 + 2 + 1; +use Test::Leaner tests => 21 + 2 + 1 + 2; my $lacunary = [ [ 1, 2, 3 ] => [ 1, 2, 3 ] ]; delete $lacunary->[0]->[1]; @@ -100,3 +100,13 @@ push @tests, [ map Test::Leaner::TestIsDeeplyOverload->new('foo'), 1 .. 2 ]; for my $t (@tests) { is_deeply $t->[0], $t->[1]; } + +# Test vivification of deleted elements of an array + +{ + my @l = (1); + $l[2] = 3; + is_deeply \@l, [ 1, undef, 3 ]; + delete $l[2]; + is_deeply \@l, [ 1 ]; +}