| Subject: | has_circular_ref is fooled by combination of weak and strong references |
The has_circular_ref() function can be fooled by the following combination of weak and strong references:
my $obj = { key1 => {} };
$obj->{key2}{key3} = $obj->{key1}; # strong ref
weaken $obj->{key1};
Apparently it sees the weak reference of key1 first, and never catches the strong references nested more deeply in the data structure.
I'm not sure how to work around this.
I've attached a version of 02circular.t which includes a test for this, and also cleans up testing for the existence of Scalar::Util::weaken().
On a semi-related note, this function would be much more useful if it could indicate exactly where the circular refs occur, as oppoosed to simply saying they exist.
#!/usr/bin/perl
use strict;
use warnings;
use blib;
use Data::Structure::Util qw(has_utf8 utf8_off utf8_on unbless get_blessed has_circular_ref);
use Data::Dumper;
our $WEAKEN;
BEGIN {
eval q{ use Scalar::Util qw(weaken isweak) };
if ($@) {
eval q{ use Test::Simple tests => 13 };
}
else {
eval q{ use Test::Simple tests => 17 };
$WEAKEN = 1 if defined &Scalar::Util::weaken;
}
}
ok(1,"we loaded fine...");
my $obj = bless {
key1 => [1, 2, 3, bless {} => 'Tagada'],
key2 => undef,
key3 => {
key31 => {},
key32 => bless { bla => [] } => 'Tagada',
},
key5 => bless [] => 'Ponie',
} => 'Scoobidoo';
$obj->{key4} = \$obj;
$obj->{key3}->{key33} = $obj->{key3}->{key31};
my $thing = { var1 => {} };
$thing->{var2} = [ $thing->{var1}->{hello } ];
$thing->{var1}->{hello} = $thing->{var2};
my $obj2 = { key1 => [ sub { [] } ] };
$obj2->{key2} = $obj2->{key1};
my $obj3;
$obj3 = \$obj3;
my $obj4 = { key1 => $obj3 };
our @V1 = (1, 2, sub {} );
my $obj5 = {
key1 => undef,
key2 => sub {},
key3 => \@V1,
key4 => $obj2,
key5 => {
key51 => sub {},
key52 => \*STDERR,
key53 => [0, \"hello"],
},
};
$obj5->{key5}->{key53}->[2] = $obj5->{key5};
$obj5->{key5}->{key54} = $obj5->{key5}->{key53}->[2];
$obj5->{key6} = $obj5->{key5}->{key53}->[2];
$obj5->{key5}->{key55} = $obj5->{key5}->{key53}->[2];
my $obj6 = { key1 => undef };
$obj = $obj6;
my $V2 = [1, undef, \5, sub {} ];
foreach (1 .. 50) {
$obj->{key2} = {};
$obj->{key1} = $V2;
$obj = $obj->{key2};
}
$obj->{key3} = \$obj6;
ok(! has_circular_ref($thing), "Not a circular ref");
my $ref = has_circular_ref($obj);
ok($ref, "Got a circular reference");
ok($ref == $obj, "reference is correct");
ok(! has_circular_ref($obj2), "No circular reference");
ok(has_circular_ref($obj3), "Got a circular reference");
ok(has_circular_ref($obj4), "Got a circular reference");
ok(has_circular_ref($obj5), "Got a circular reference");
ok(has_circular_ref($obj6), "Got a circular reference");
ok($obj6 == has_circular_ref($obj6), "Match reference");
ok(! has_circular_ref(), "No circular reference");
ok(! has_circular_ref( [] ), "No circular reference");
ok(has_circular_ref( [ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\$ref ] ), "Has circular reference");
if ($WEAKEN) {
my $obj7 = { key1 => {} };
$obj7->{key1}->{key11} = $obj7->{key1};
ok(has_circular_ref($obj7), "Got a circular reference");
weaken($obj7->{key1}->{key11});
ok(isweak($obj7->{key1}->{key11}), "has weaken reference");
ok(! has_circular_ref($obj7), "No more circular reference");
my $obj8 = { key1 => {} };
$obj8->{key2}{key3} = $obj8->{key1};
weaken $obj8->{key1};
ok(has_circular_ref($obj8));
}
else {
warn "Scalar::Util XS version not installed, some tests skipped\n";
}