There is a fairly major race condition in Data::Compare
I'll start with the following moderately deeply nested structure
my $c = bless { foo => 1 }, 'Foo';
my $d = bless { c => $c }, "Foo::D";
my $e = bless { d => $d }, "Foo::E";
my $f = bless { e => $e }, "Foo::F";
my $g = bless { f => $f }, "Foo::G";
my $h = bless { g => $g }, "Foo::H";
my $i = bless { h => $h }, "Foo::I";
my $j = bless { i => $i }, "Foo::J";
my $k = Clone::clone $j;
Data::Compare::Compare( $j, $k );
By the time we get somewhere near the bottom of the pile, we have a %been_there index similar to the following
0 HASH(0x8247cd0)
'Foo::D=HASH(0x83681f4)' => 1
'Foo::D=HASH(0x843c36c)' => 1
'Foo::E=HASH(0x84288e8)' => 1
'Foo::E=HASH(0x843c2e8)' => 1
'Foo::F=HASH(0x8428978)' => 1
'Foo::F=HASH(0x843c300)' => 1
'Foo::G=HASH(0x84289b4)' => 1
'Foo::G=HASH(0x843c30c)' => 1
'Foo::H=HASH(0x84289f0)' => 1
'Foo::H=HASH(0x843c330)' => 1
'Foo::I=HASH(0x8428a2c)' => 1
'Foo::I=HASH(0x8428a50)' => 1
'Foo::J=HASH(0x8428a68)' => 1
'Foo::J=HASH(0x843c2dc)' => 1
'HASH(0x836e2c4)' => 1
'HASH(0x836e300)' => 1
'HASH(0x8486eb4)' => 1
'HASH(0x8486ed8)' => 1
'HASH(0x84951e8)' => 1
'HASH(0x849520c)' => 1
'HASH(0x8497dd8)' => 1
'HASH(0x8497e68)' => 1
'HASH(0x849a8dc)' => 1
'HASH(0x849a900)' => 1
'HASH(0x849c87c)' => 1
'HASH(0x849c8d0)' => 1
'HASH(0x849ea10)' => 1
'HASH(0x849ea7c)' => 1
Now, while it's all well and good to do a been_there check on the ACTUAL objects we are testing, where the hell are the HASH(...) entries coming from.
In this case it's from somewhere like the following.
Data::Compare::Compare(/usr/lib/perl5/site_perl/5.8.0/Data/Compare.pm:188):
188: my %x = %$x;
This creates a NEW temporary hash at a somewhat random memory location, and then adds it to %been_there when we go inside it. Looking at the following...
{
a => (lots of deep nested objects),
b => (lots of deep nested objects),
}
... you imagine that a LOT of these temporary hashes will get created during the testing of 'a' and these won't be cleared. The been_there entries still exist, even though the temporary hashes no longer exist.
When we head down the 'b' branch, one of these temporary hashes can be created and the same memory location can be reused. This results in the temporary hashes colliding in the been_there index, and the Compare returning false.
This is not theoretical, it's happening in the main test script for PPI::Analysis::Compare on my system.
I forsee a couple of solutions.
The easiest would be to decrement the been_there value after you are done with the temporary hash, just before they fall out of scope. This would prevent collisions later on, but otherwise leave the function unchanged.
The second would be to completely overhaul been_there using Scalar::Util::refaddr or something similar that doesn't rely on stringification.
To quickly provide the solution, change
else { # a package name (object blessed)
my ($type) = "$x" =~ m/^$refx=(\S+)\(/;
if ($type eq 'HASH') {
my %x = %$x;
my %y = %$y;
return Compare(\%x, \%y, $opts);
}
elsif ($type eq 'ARRAY') {
my @x = @$x;
my @y = @$y;
return Compare(\@x, \@y, $opts);
}
to
else { # a package name (object blessed)
my ($type) = "$x" =~ m/^$refx=(\S+)\(/;
if ($type eq 'HASH') {
my %x = %$x;
my %y = %$y;
my $rv = Compare(\%x, \%y, $opts);
$been_there{\%x}--;
$been_there{\%y}--;
return $rv;
}
elsif ($type eq 'ARRAY') {
my @x = @$x;
my @y = @$y;
my $rv = Compare(\@x, \@y, $opts);
$been_there{\@x}--;
$been_there{\@y}--;
return $rv;
}
Anyways, I hope you see my point, and apply the changes listed, or an equivalent.
RT for rt.cpan.org