| Subject: | Support for closures in a new Devel::Cycle |
Hi Andy,
The next version of Devel::Cycle will support closures, and Test::Memory::Cycle requires some
changes in order to report such cycles:
This has been discussed here: http://www.nntp.perl.org/group/perl.qa/5919
The patch in question is attached to this bug.
I asked LDS to tell you when Devel::Cycle is released with support for this, so please coordinate
with him.
Thanks!
| Subject: | Test-Memory-Cycle.patch |
diff -Nur Test-Memory-Cycle-1.02/Cycle.pm Test-Memory-Cycle-with_code/Cycle.pm
--- Test-Memory-Cycle-1.02/Cycle.pm 2005-05-17 19:02:39.000000000 +0300
+++ Test-Memory-Cycle-with_code/Cycle.pm 2006-04-24 00:54:16.000000000 +0300
@@ -98,6 +98,7 @@
$str = sprintf(" %s => %s",$refdisp,$valuedisp) if $type eq 'SCALAR';
$str = sprintf(" %s => %s","${refdisp}->[$index]",$valuedisp) if $type eq 'ARRAY';
$str = sprintf(" %s => %s","${refdisp}->{$index}",$valuedisp) if $type eq 'HASH';
+ $str = sprintf(" closure %s => %s","${refdisp}, $index",$valuedisp) if $type eq 'CODE';
push( @diags, $str );
}
@@ -213,6 +214,7 @@
$sigil = '%' if $sigil eq "HASH ";
$sigil = '@' if $sigil eq "ARRAY ";
$sigil = '$' if $sigil eq "REF ";
+ $sigil = '&' if $sigil eq "CODE ";
$refdisp = $shortnames{ $refstr } = $sigil . $new_shortname++;
}
diff -Nur Test-Memory-Cycle-1.02/t/family-code.t Test-Memory-Cycle-with_code/t/family-code.t
--- Test-Memory-Cycle-1.02/t/family-code.t 1970-01-01 02:00:00.000000000 +0200
+++ Test-Memory-Cycle-with_code/t/family-code.t 2006-04-24 00:55:14.000000000 +0300
@@ -0,0 +1,34 @@
+#!perl -T
+
+use strict;
+use warnings FATAL => 'all';
+
+use Scalar::Util qw( weaken );
+
+use Test::More tests => 4;
+#use Test::Builder::Tester; # not used yet
+
+# use ok "Test::Memory::Cycle";
+BEGIN {
+ use_ok( 'Test::Memory::Cycle' );
+}
+
+my $code_refs_parent = { };
+$code_refs_parent->{child} = sub { $code_refs_parent };
+
+my $code_refs_self;
+$code_refs_self = sub { $code_refs_self };
+
+my $code_refs_parent_weak = { };
+$code_refs_parent_weak->{child} = do {
+ my $weak_parent = $code_refs_parent_weak;
+ weaken( $weak_parent );
+ sub { $weak_parent };
+};
+
+memory_cycle_exists( $code_refs_parent, "code refs referencing containers" );
+memory_cycle_exists( $code_refs_self, "code refs referencing themselves" );
+memory_cycle_ok( $code_refs_parent_weak, "code refs with weak refs to containers" );
+
+# the output can be tested later if someone cares
+