r22961 - in /branches/upstream/libdevel-cycle-perl/current: Changes META.yml lib/Devel/Cycle.pm t/Devel-Cycle.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Wed Jul 9 16:37:33 UTC 2008
Author: gregoa
Date: Wed Jul 9 16:37:33 2008
New Revision: 22961
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=22961
Log:
[svn-upgrade] Integrating new upstream version, libdevel-cycle-perl (1.10)
Modified:
branches/upstream/libdevel-cycle-perl/current/Changes
branches/upstream/libdevel-cycle-perl/current/META.yml
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/pkg-perl/branches/upstream/libdevel-cycle-perl/current/Changes?rev=22961&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/Changes (original)
+++ branches/upstream/libdevel-cycle-perl/current/Changes Wed Jul 9 16:37:33 2008
@@ -1,4 +1,7 @@
Revision history for Perl extension Devel::Cycle.
+1.10 Tue Jul 8 21:27:20 EDT 2008
+ - Slaven Rezic fixed bug 35825.
+
1.09 Mon Apr 14 12:54:56 EDT 2008
-Dave Rolsky identified and fixed bug 25360.
Modified: branches/upstream/libdevel-cycle-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-cycle-perl/current/META.yml?rev=22961&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/META.yml (original)
+++ branches/upstream/libdevel-cycle-perl/current/META.yml Wed Jul 9 16:37:33 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Devel-Cycle
-version: 1.09
+version: 1.10
abstract: Find memory cycles in objects
license: ~
author:
Modified: branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm?rev=22961&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm (original)
+++ branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm Wed Jul 9 16:37:33 2008
@@ -1,12 +1,12 @@
package Devel::Cycle;
-# $Id: Cycle.pm,v 1.12 2008/04/14 17:01:37 lstein Exp $
+# $Id: Cycle.pm,v 1.13 2008/07/09 01:26:45 lstein Exp $
use 5.006001;
use strict;
use Carp 'croak','carp';
use warnings;
-use Scalar::Util qw(isweak blessed refaddr);
+use Scalar::Util qw(isweak blessed refaddr reftype);
my $SHORT_NAME = 'A';
my %SHORT_NAMES;
@@ -17,7 +17,7 @@
our @ISA = qw(Exporter);
our @EXPORT = qw(find_cycle find_weakened_cycle);
our @EXPORT_OK = qw($FORMATTING);
-our $VERSION = '1.09';
+our $VERSION = '1.10';
our $FORMATTING = 'roasted';
our $QUIET = 0;
@@ -100,9 +100,15 @@
sub _find_cycle_dispatch {
my $type = _get_type($_[0]);
+ if (!defined $type) {
+ my $ref = reftype $_[0];
+ our %already_warned;
+ if (!$already_warned{$ref}++) {
+ warn "Unhandled type: $ref";
+ }
+ return;
+ }
my $sub = do { no strict 'refs'; \&{"_find_cycle_$type"} };
- die "Invalid type: $type" unless $sub;
-
$sub->(@_);
}
@@ -213,6 +219,7 @@
return 'ARRAY' if UNIVERSAL::isa($thingy,'ARRAY');
return 'HASH' if UNIVERSAL::isa($thingy,'HASH');
return 'CODE' if UNIVERSAL::isa($thingy,'CODE');
+ undef;
}
sub _format_index {
Modified: branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t?rev=22961&op=diff
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t (original)
+++ branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t Wed Jul 9 16:37:33 2008
@@ -5,7 +5,7 @@
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 9;
+use Test::More tests => 12;
use Scalar::Util qw(weaken isweak);
BEGIN { use_ok('Devel::Cycle') };
@@ -14,7 +14,7 @@
my $test = {fred => [qw(a b c d e)],
ethel => [qw(1 2 3 4 5)],
george => {martha => 23,
- agnes => 19}
+ agnes => 19},
};
$test->{george}{phyllis} = $test;
$test->{fred}[3] = $test->{george};
@@ -86,6 +86,21 @@
is($counter,3,'found three cycles in $cyclical closure');
}
+{
+ *FOOBAR = *FOOBAR if 0; # cease -w
+ my $test2 = { glob => \*FOOBAR };
+
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
+ find_cycle($test2);
+ pass("No failure if encountering glob");
+ like("@warnings", qr{unhandled type.*glob}i, "Expected warning");
+
+ @warnings = ();
+ find_cycle($test2);
+ is("@warnings", "", "Warn only once");
+}
+
package foo;
use overload q("") => sub{ return 1 }; # show false alarm
More information about the Pkg-perl-cvs-commits
mailing list