# # # To apply this patch: # STEP 1: Chdir to the source directory. # STEP 2: Run the 'applypatch' program with this patch file as input. # # If you do not have 'applypatch', it is part of the 'makepatch' package # that you can fetch from the Comprehensive Perl Archive Network: # http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz # In the above URL, 'x' should be 2 or higher. # # To apply this patch without the use of 'applypatch': # STEP 1: Chdir to the source directory. # STEP 2: Run the 'patch' program with this file as input. # #### End of Preamble #### #### Patch data follows #### diff -up 'build/Devel-Cycle-1.09-DSMJ9Q/lib/Devel/Cycle.pm' 'new.build/Devel-Cycle-1.09/lib/Devel/Cycle.pm' Index: ./lib/Devel/Cycle.pm Prereq: 1.12 --- ./lib/Devel/Cycle.pm Mon Apr 14 19:01:37 2008 +++ ./lib/Devel/Cycle.pm Tue Jul 8 15:51:39 2008 @@ -6,7 +6,7 @@ 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; @@ -100,9 +100,15 @@ sub _find_cycle { 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 @@ sub _get_type { 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 { diff -up 'build/Devel-Cycle-1.09-DSMJ9Q/t/Devel-Cycle.t' 'new.build/Devel-Cycle-1.09/t/Devel-Cycle.t' Index: ./t/Devel-Cycle.t --- ./t/Devel-Cycle.t Mon Apr 14 18:54:33 2008 +++ ./t/Devel-Cycle.t Tue Jul 8 15:49: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 @@ BEGIN { use_ok('Devel::Cycle') }; 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 @@ SKIP: 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 #### End of Patch data #### #### ApplyPatch data follows #### # Data version : 1.0 # Date generated : Tue Jul 8 16:01:43 2008 # Generated by : makepatch 2.00_12* # Recurse directories : Yes # Excluded files : (\A|/).*\~\Z # (\A|/).*\.a\Z # (\A|/).*\.bak\Z # (\A|/).*\.BAK\Z # (\A|/).*\.elc\Z # (\A|/).*\.exe\Z # (\A|/).*\.gz\Z # (\A|/).*\.ln\Z # (\A|/).*\.o\Z # (\A|/).*\.obj\Z # (\A|/).*\.olb\Z # (\A|/).*\.old\Z # (\A|/).*\.orig\Z # (\A|/).*\.rej\Z # (\A|/).*\.so\Z # (\A|/).*\.Z\Z # (\A|/)\.del\-.*\Z # (\A|/)\.make\.state\Z # (\A|/)\.nse_depinfo\Z # (\A|/)core\Z # (\A|/)tags\Z # (\A|/)TAGS\Z # p 'lib/Devel/Cycle.pm' 13342 1215525099 0100644 # p 't/Devel-Cycle.t' 2454 1215524968 0100755 #### End of ApplyPatch data #### #### End of Patch kit [created: Tue Jul 8 16:01:43 2008] #### #### Patch checksum: 119 3695 55028 #### #### Checksum: 137 4320 41078 ####