r22963 - in /trunk/libdevel-cycle-perl: Changes META.yml debian/changelog lib/Devel/Cycle.pm t/Devel-Cycle.t

[gregoa at users.alioth.debian.org]

Author: gregoa
Date: Wed Jul  9 16:38:28 2008
New Revision: 22963

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=22963
Log:
New upstream release.

Modified:
    trunk/libdevel-cycle-perl/Changes
    trunk/libdevel-cycle-perl/META.yml
    trunk/libdevel-cycle-perl/debian/changelog
    trunk/libdevel-cycle-perl/lib/Devel/Cycle.pm
    trunk/libdevel-cycle-perl/t/Devel-Cycle.t

Modified: trunk/libdevel-cycle-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-cycle-perl/Changes?rev=22963&op=diff
==============================================================================
--- trunk/libdevel-cycle-perl/Changes (original)
+++ trunk/libdevel-cycle-perl/Changes Wed Jul  9 16:38:28 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: trunk/libdevel-cycle-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-cycle-perl/META.yml?rev=22963&op=diff
==============================================================================
--- trunk/libdevel-cycle-perl/META.yml (original)
+++ trunk/libdevel-cycle-perl/META.yml Wed Jul  9 16:38:28 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: trunk/libdevel-cycle-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-cycle-perl/debian/changelog?rev=22963&op=diff
==============================================================================
--- trunk/libdevel-cycle-perl/debian/changelog (original)
+++ trunk/libdevel-cycle-perl/debian/changelog Wed Jul  9 16:38:28 2008
@@ -1,3 +1,9 @@
+libdevel-cycle-perl (1.10-1) UNRELEASED; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org>  Wed, 09 Jul 2008 18:37:50 +0200
+
 libdevel-cycle-perl (1.09-1) unstable; urgency=low
 
   * New upstream release.

Modified: trunk/libdevel-cycle-perl/lib/Devel/Cycle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-cycle-perl/lib/Devel/Cycle.pm?rev=22963&op=diff
==============================================================================
--- trunk/libdevel-cycle-perl/lib/Devel/Cycle.pm (original)
+++ trunk/libdevel-cycle-perl/lib/Devel/Cycle.pm Wed Jul  9 16:38:28 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: trunk/libdevel-cycle-perl/t/Devel-Cycle.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-cycle-perl/t/Devel-Cycle.t?rev=22963&op=diff
==============================================================================
--- trunk/libdevel-cycle-perl/t/Devel-Cycle.t (original)
+++ trunk/libdevel-cycle-perl/t/Devel-Cycle.t Wed Jul  9 16:38:28 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