r18617 - in /branches/upstream/libdevel-cycle-perl/current: Changes META.yml Makefile.PL lib/Devel/Cycle.pm t/Devel-Cycle.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Tue Apr 15 15:46:50 UTC 2008
Author: gregoa-guest
Date: Tue Apr 15 15:46:49 2008
New Revision: 18617
URL: http://svn.debian.org/wsvn/?sc=1&rev=18617
Log:
[svn-upgrade] Integrating new upstream version, libdevel-cycle-perl (1.09)
Modified:
branches/upstream/libdevel-cycle-perl/current/Changes
branches/upstream/libdevel-cycle-perl/current/META.yml
branches/upstream/libdevel-cycle-perl/current/Makefile.PL
branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm
branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t
Modified: branches/upstream/libdevel-cycle-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/Changes?rev=18617&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/Changes (original)
+++ branches/upstream/libdevel-cycle-perl/current/Changes Tue Apr 15 15:46:49 2008
@@ -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!
Modified: branches/upstream/libdevel-cycle-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/META.yml?rev=18617&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/META.yml (original)
+++ branches/upstream/libdevel-cycle-perl/current/META.yml Tue Apr 15 15:46:49 2008
@@ -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 @@
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
Modified: branches/upstream/libdevel-cycle-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/Makefile.PL?rev=18617&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/Makefile.PL (original)
+++ branches/upstream/libdevel-cycle-perl/current/Makefile.PL Tue Apr 15 15:46:49 2008
@@ -5,7 +5,9 @@
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 <lstein at cshl.edu>') : ()),
Modified: branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm?rev=18617&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm (original)
+++ branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm Tue Apr 15 15:46:49 2008
@@ -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 @@
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 @@
_do_report(++$counter,shift)
}
}
- _find_cycle($ref,{},$callback,1,());
+ _find_cycle($ref,{},$callback,1,{},());
}
sub find_cycle {
@@ -67,7 +67,7 @@
_do_report(++$counter,shift)
}
}
- _find_cycle($ref,{},$callback,0,());
+ _find_cycle($ref,{},$callback,0,{},());
}
sub _find_cycle {
@@ -75,7 +75,7 @@
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 @@
}
$seenit->{refaddr $current}++;
- my $type = _get_type($current);
-
- 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):()]));
- }
-
- 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]):()]));
+ _find_cycle_dispatch($current,{%$seenit},$callback,$inc_weak_refs,$complain, at report);
+}
+
+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 = @_;
+
+ 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]));
}
}
Modified: branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t?rev=18617&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t (original)
+++ branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t Tue Apr 15 15:46:49 2008
@@ -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 @@
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
More information about the Pkg-perl-cvs-commits
mailing list