Data-Structure-Util
view release on metacpan or search on metacpan
0.07 Mon Jan 19 09:50:00 2004
- Added get_refs() and signature()
- Updated doc
0.06 Tue Dec 30 10:27:00 2003
- Changed C++ style comments to C style comments - Thanks Leon
- Fixed bug in has_circular_ref() and circular_off() where there was a weak ref:
in some cases, a circular ref could be wrongly reported.
0.05
- Added circular_off() to weaken references when a circular ref is found
- Added 02circular_off.t
- Added bin/packages.pl to scan all global variables for circular refs
- Cleaned 02circular.t - Thanks autarch
- Updated doc
0.04
- Circular reference detection is smarter in presence of weak references
- Removed warnings from tests
0.03 Tue Nov 05 23:25:00 2003
- Added support for weaken references in has_circular_ref()
- Added prototyping of XS functions
- Updated documentation
0.02 Tue Nov 04 22:05:00 2003
- Fixed compilations issues with old versions of gcc - Thanks Leon
- has_utf8(), utf8_on() and utf8_off() now return the first parameter
- skip utf8 tests if perl version < 5.8.0
- Removed SIGNATURE from MANIFEST
0.01 Fri Oct 31 14:00:00 2003
sprintf( addr, "%p", SvRV( sv ) );
len = strlen( addr );
if ( hv_exists( parents, addr, len ) ) {
if ( SvWEAKREF( sv ) ) {
dsWARN( "found a weak reference" );
}
else {
dsWARN( "found a circular reference!!!" );
sv_rvweaken( sv );
sv_inc( counter );
}
}
else {
if ( hv_exists( seen, addr, len ) ) {
dsWARN( "circular reference on weak ref" );
return &PL_sv_undef;
}
dsWARN( "Array" );
for ( i = 0; i <= av_len( ( AV * ) sv ); i++ ) {
#if dsDEBUG
sprintf( errmsg, "next elem %i\n", i );
warn( errmsg );
#endif
AValue = av_fetch( ( AV * ) sv, i, 0 );
if ( AValue ) {
_circular_off( *AValue, parents, seen, counter );
if ( SvTYPE( sv ) != SVt_PVAV ) {
/* In some circumstances, weakening a reference screw things up */
croak
( "Array that we were weakening suddenly turned into a scalar of type type %d",
SvTYPE( sv ) );
}
}
}
break;
}
case SVt_PVHV:{ /* Hash */
dsWARN( "Hash" );
myHash = ( HV * ) sv;
hv_iterinit( myHash );
while (( HEntry = hv_iternext( myHash ) )) {
#if dsDEBUG
STRLEN len2;
char *HKey = HePV( HEntry, len2 );
sprintf( errmsg, "NEXT KEY is %s\n", HKey );
warn( errmsg );
#endif
_circular_off( HeVAL( HEntry ), parents, seen,
counter );
if ( SvTYPE( sv ) != SVt_PVHV ) {
/* In some circumstances, weakening a reference screw things up */
croak
( "Hash that we were weakening suddenly turned into a scalar of type type %d",
SvTYPE( sv ) );
}
}
break;
}
default: ;
}
}
return counter;
}
lib/Data/Structure/Util.pm view on Meta::CPAN
have already visited. Data structures that have circular references will
not be automatically reclaimed by Perl's garbage collector.
If a circular reference is detected the function returns a reference
to an element within circuit, otherwise the function will return a
false value.
If the version of perl that you are using supports weak references then
any weak references found within the data structure will not be
traversed, meaning that circular references that have had links
successfully weakened will not be returned by this function.
=item circular_off($ref)
Detects circular references in $ref (as above) and weakens a link in
each so that they can be properly garbage collected when no external
references to the data structure are left.
This means that one (or more) of the references in the data structure
will be told that the should not count towards reference counting. You
should be aware that if you later modify the data structure and leave
parts of it only 'accessible' via weakened references that those parts
of the data structure will be immediately garbage collected as the
weakened references will not be strong enough to maintain the connection
on their own.
The number of references weakened is returned.
=item get_refs($ref)
Examine the data structure and return a reference to flat array that
contains one copy of every reference in the data structure you passed.
For example:
my $foo = {
first => [ "inner", "array", { inmost => "hash" } ],
t/02circular.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use blib;
use Data::Structure::Util qw(unbless get_blessed has_circular_ref);
use Data::Dumper;
my $WEAKEN;
eval q{ use Scalar::Util qw(weaken isweak) };
if ( !$@ and defined &Scalar::Util::weaken ) {
$WEAKEN = 1;
}
use Test::More;
plan tests => 14 + 6 * $WEAKEN;
ok( 1, "we loaded fine..." );
my $obj = bless {
t/02circular.t view on Meta::CPAN
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
= bless { key1 => bless { parent => undef, } => 'Bar', } => 'Foo';
$obj8->{key1}->{parent} = $obj8;
ok( has_circular_ref( $obj8 ), "Got circular" );
my $obj81 = $obj8->{key1};
weaken( $obj8->{key1} );
ok( isweak( $obj8->{key1} ), "is weak" );
ok( !has_circular_ref( $obj8 ), "Got no circular" );
}
else {
warn "Scalar::Util XS version not installed, some tests skipped\n";
}
my $a;
my $r;
t/02circular_off.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use blib;
use Data::Structure::Util qw(has_circular_ref circular_off);
use Data::Dumper;
BEGIN {
eval q{ use Scalar::Util qw(weaken isweak) };
if ( $@ ) {
my $reason
= "A recent version of Scalar::Util must be installed";
eval qq{ use Test::More skip_all => "$reason" };
exit;
}
else {
eval q{ use Test::More tests => 35 };
}
}
t/02circular_off.t view on Meta::CPAN
}
ok( !has_circular_ref( $thing ), "Not a circular ref" );
{
is( circular_off( $thing ), 0, "No circular ref broken" );
}
my $ref = has_circular_ref( $obj );
ok( $ref, "Got a circular reference" );
is( circular_off( $obj ), 1, "Weaken circular references" );
is( circular_off( $obj ), 0, "No more weaken circular references" );
ok( !has_circular_ref( $obj ), "No more circular ref" );
ok( !has_circular_ref( $obj2 ), "No circular reference" );
is( circular_off( $obj2 ), 0, "No circular ref broken" );
ok( has_circular_ref( [ $obj3, $obj4, $obj5 ] ),
"Got a circular reference" );
is( circular_off( [ $obj3, $obj4, $obj5 ] ),
4, "Weaken circular references" );
ok( !has_circular_ref( [ $obj3, $obj4, $obj5 ] ),
t/02circular_off.t view on Meta::CPAN
ok( !has_circular_ref(), "No circular reference" );
ok( !has_circular_ref( [] ), "No circular reference" );
ok( !has_circular_ref( [ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\$ref ] ),
"Has circular reference" );
my $spy;
{
my $obj7 = { key1 => {} };
$obj7->{key1}->{key11} = $obj7->{key1};
$spy = $obj7->{key1};
weaken( $spy );
ok( isweak( $spy ), "got a spy" );
ok( has_circular_ref( $obj7 ), "Got a circular reference" );
is( circular_off( $obj7 ), 1, "Removed circular refs" );
}
ok( !$spy, "No memory leak" );
my $obj8
= bless { key1 => bless { parent => undef, } => 'Bar', } => 'Foo';
$obj8->{key1}->{parent} = $obj8;
ok( has_circular_ref( $obj8 ), "Got circular" );
is( circular_off( $obj8 ), 1, "removed circular" );
ok( isweak( $obj8->{key1}->{parent} ), "is weak" );
ok( !has_circular_ref( $obj8 ), "no circular" );
ok( !circular_off( $obj8 ), "removed circular" );
my $obj9
= bless { key1 => bless { parent => undef, } => 'Bar', } => 'Foo';
$obj9->{key1}->{parent} = $obj9;
ok( has_circular_ref( $obj9 ), "got circular" );
my $obj91 = $obj9->{key1};
weaken( $obj9->{key1} );
ok( isweak( $obj9->{key1} ), "is weak" );
ok( !has_circular_ref( $obj9 ), "no circular" );
ok( !circular_off( $obj9 ), "no circular" );
$obj8 = {};
$obj8->{a} = \$obj8;
is( circular_off( $obj8 ), 1, "Removed circular refs" );
$obj8 = [];
$obj8->[0] = \$obj8;
( run in 0.317 second using v1.01-cache-2.11-cpan-65fba6d93b7 )