From 236565934bd0d9beed9951903f9bc7819c81af83 Mon Sep 17 00:00:00 2001 From: "Lincoln D. Stein" Date: Mon, 14 Apr 2008 18:04:58 +0100 Subject: [PATCH] import Devel::Cycle 1.09 from CPAN git-cpan-module: Devel::Cycle git-cpan-version: 1.09 --- Changes | 3 ++ META.yml | 3 +- Makefile.PL | 4 +- lib/Devel/Cycle.pm | 108 +++++++++++++++++++++++++++++++-------------- t/Devel-Cycle.t | 24 +++++++++- 5 files changed, 106 insertions(+), 36 deletions(-) diff --git a/Changes b/Changes index 0754beb..a0882ba 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,7 @@ Revision history for Perl extension Devel::Cycle. +1.09 Mon Apr 14 12:54:56 EDT 2008 + -Dave Rolsky identified and fixed bug 25360. + 1.08 Fri Apr 11 17:55:59 EDT 2008 - Peter Brakemeier identified and patched bug in which stringified objects could create false positives. Thanks Peter! diff --git a/META.yml b/META.yml index c2707bc..0851ec5 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: Devel-Cycle -version: 1.08 +version: 1.09 abstract: Find memory cycles in objects license: ~ author: @@ -9,6 +9,7 @@ generated_by: ExtUtils::MakeMaker version 6.44 distribution_type: module requires: Scalar::Util: 0 + Test::More: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 diff --git a/Makefile.PL b/Makefile.PL index 4fe812c..16c1f44 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,7 +5,9 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Devel::Cycle', VERSION_FROM => 'lib/Devel/Cycle.pm', # finds $VERSION - PREREQ_PM => {'Scalar::Util' => 0}, # e.g., Module::Name => 1.1 + PREREQ_PM => {'Scalar::Util' => 0, + 'Test::More' => 0, + }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Devel/Cycle.pm', # retrieve abstract from module AUTHOR => 'Lincoln Stein ') : ()), diff --git a/lib/Devel/Cycle.pm b/lib/Devel/Cycle.pm index 7598acf..b42fc43 100644 --- a/lib/Devel/Cycle.pm +++ b/lib/Devel/Cycle.pm @@ -1,5 +1,5 @@ package Devel::Cycle; -# $Id: Cycle.pm,v 1.11 2008/04/11 21:57:13 lstein Exp $ +# $Id: Cycle.pm,v 1.12 2008/04/14 17:01:37 lstein Exp $ use 5.006001; use strict; @@ -17,7 +17,7 @@ require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(find_cycle find_weakened_cycle); our @EXPORT_OK = qw($FORMATTING); -our $VERSION = '1.08'; +our $VERSION = '1.09'; our $FORMATTING = 'roasted'; our $QUIET = 0; @@ -55,7 +55,7 @@ sub find_weakened_cycle { _do_report(++$counter,shift) } } - _find_cycle($ref,{},$callback,1,()); + _find_cycle($ref,{},$callback,1,{},()); } sub find_cycle { @@ -67,7 +67,7 @@ sub find_cycle { _do_report(++$counter,shift) } } - _find_cycle($ref,{},$callback,0,()); + _find_cycle($ref,{},$callback,0,{},()); } sub _find_cycle { @@ -75,7 +75,7 @@ sub _find_cycle { my $seenit = shift; my $callback = shift; my $inc_weak_refs = shift; - my %complain; + my $complain = shift; my @report = @_; return unless ref $current; @@ -94,40 +94,82 @@ sub _find_cycle { } $seenit->{refaddr $current}++; - my $type = _get_type($current); + _find_cycle_dispatch($current,{%$seenit},$callback,$inc_weak_refs,$complain,@report); +} - if ($type eq 'SCALAR') { - return if !$inc_weak_refs && isweak($current); - _find_cycle($$current,{%$seenit},$callback,$inc_weak_refs, - (@report,['SCALAR',undef,$current => $$current,$inc_weak_refs?isweak($current):()])); - } +sub _find_cycle_dispatch { + my $type = _get_type($_[0]); + + my $sub = do { no strict 'refs'; \&{"_find_cycle_$type"} }; + die "Invalid type: $type" unless $sub; + + $sub->(@_); +} + +sub _find_cycle_SCALAR { + my $current = shift; + my $seenit = shift; + my $callback = shift; + my $inc_weak_refs = shift; + my $complain = shift; + my @report = @_; - elsif ($type eq 'ARRAY') { - for (my $i=0; $i<@$current; $i++) { - next if !$inc_weak_refs && isweak($current->[$i]); - _find_cycle($current->[$i],{%$seenit},$callback,$inc_weak_refs, - (@report,['ARRAY',$i,$current => $current->[$i],$inc_weak_refs?isweak($current->[$i]):()])); + return if !$inc_weak_refs && isweak($current); + _find_cycle($$current,{%$seenit},$callback,$inc_weak_refs,$complain, + (@report,['SCALAR',undef,$current => $$current,$inc_weak_refs?isweak($current):()])); +} + +sub _find_cycle_ARRAY { + my $current = shift; + my $seenit = shift; + my $callback = shift; + my $inc_weak_refs = shift; + my $complain = shift; + my @report = @_; + + for (my $i=0; $i<@$current; $i++) { + next if !$inc_weak_refs && isweak($current->[$i]); + _find_cycle($current->[$i],{%$seenit},$callback,$inc_weak_refs,$complain, + (@report,['ARRAY',$i,$current => $current->[$i],$inc_weak_refs?isweak($current->[$i]):()])); } - } - elsif ($type eq 'HASH') { - for my $key (sort keys %$current) { - next if !$inc_weak_refs && isweak($current->{$key}); - _find_cycle($current->{$key},{%$seenit},$callback,$inc_weak_refs, - (@report,['HASH',$key,$current => $current->{$key},$inc_weak_refs?isweak($current->{$key}):()])); +} + +sub _find_cycle_HASH { + my $current = shift; + my $seenit = shift; + my $callback = shift; + my $inc_weak_refs = shift; + my $complain = shift; + my @report = @_; + + for my $key (sort keys %$current) { + next if !$inc_weak_refs && isweak($current->{$key}); + _find_cycle($current->{$key},{%$seenit},$callback,$inc_weak_refs,$complain, + (@report,['HASH',$key,$current => $current->{$key},$inc_weak_refs?isweak($current->{$key}):()])); } - } - elsif ($type eq 'CODE') { - if (HAVE_PADWALKER) { - my $closed_vars = PadWalker::closed_over( $current ); - foreach my $varname ( sort keys %$closed_vars ) { - my $value = $closed_vars->{$varname}; - next if !$inc_weak_refs && isweak($$value); - _find_cycle( $$value,{%$seenit},$callback,$inc_weak_refs, - (@report,['CODE',$varname,$current => $$value,$inc_weak_refs?isweak($$value):()])); - } - } elsif (!$complain{$current}++ && !$QUIET) { +} + +sub _find_cycle_CODE { + my $current = shift; + my $seenit = shift; + my $callback = shift; + my $inc_weak_refs = shift; + my $complain = shift; + my @report = @_; + + unless (HAVE_PADWALKER) { + if (!$complain->{$current} && !$QUIET) { carp "A code closure was detected in but we cannot check it unless the PadWalker module is installed"; } + + return; + } + + my $closed_vars = PadWalker::closed_over( $current ); + foreach my $varname ( sort keys %$closed_vars ) { + my $value = $closed_vars->{$varname}; + _find_cycle_dispatch($value,{%$seenit},$callback,$inc_weak_refs,$complain, + (@report,['CODE',$varname,$current => $value])); } } diff --git a/t/Devel-Cycle.t b/t/Devel-Cycle.t index f88eb7b..4ad15f5 100644 --- a/t/Devel-Cycle.t +++ b/t/Devel-Cycle.t @@ -5,7 +5,7 @@ # change 'tests => 1' to 'tests => last_test_to_print'; -use Test::More tests => 8; +use Test::More tests => 9; use Scalar::Util qw(weaken isweak); BEGIN { use_ok('Devel::Cycle') }; @@ -64,6 +64,28 @@ $counter = 0; find_cycle($a,sub {$counter++}); is($counter,0,'found no cycles in reference stringified on purpose to create a false alarm'); +SKIP: +{ + skip 'These tests require PadWalker 1.0+', 1 + unless Devel::Cycle::HAVE_PADWALKER; + + $counter = 0; + + my %cyclical = ( a => [], + b => {}, + ); + $cyclical{a}[0] = $cyclical{a}; + $cyclical{b}{key} = $cyclical{a}; + + my @cyclical = []; + $cyclical[0] = \@cyclical; + + my $sub = sub { return \@cyclical, \%cyclical; }; + + find_cycle($sub,sub {$counter++}); + is($counter,3,'found three cycles in $cyclical closure'); +} + package foo; use overload q("") => sub{ return 1 }; # show false alarm