Devel-Cycle-1.11/0000755000175000017500000000000011244506727013116 5ustar lsteinlsteinDevel-Cycle-1.11/t/0000755000175000017500000000000011244506727013361 5ustar lsteinlsteinDevel-Cycle-1.11/t/Devel-Cycle.t0000644000175000017500000000542711035011713015632 0ustar lsteinlstein# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Devel-Cycle.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 12; use Scalar::Util qw(weaken isweak); 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}, }; $test->{george}{phyllis} = $test; $test->{fred}[3] = $test->{george}; $test->{george}{mary} = $test->{fred}; my ($test2,$test3); $test2 = \$test3; $test3 = \$test2; my $counter = 0; find_cycle($test,sub {$counter++}); is($counter,4,'found four cycles in $test'); $counter = 0; find_cycle($test2,sub {$counter++}); is($counter,1,'found one cycle in $test2'); # now fix them with weaken and make sure that gets noticed $counter = 0; weaken($test->{george}->{phyllis}); find_cycle($test,sub {$counter++}); is($counter,2,'found two cycles in $test after weaken()'); # uncomment this to test the printing # diag "Not Weak"; # find_cycle($test); # diag "Weak"; # find_weakened_cycle($test); $counter = 0; find_weakened_cycle($test,sub {$counter++}); is($counter, 4, 'found four cycles (including weakened ones) in $test after weaken()'); $counter = 0; weaken($test->{fred}[3]); find_cycle($test,sub {$counter++}); is($counter,0,'found no cycles in $test after second weaken()'); $counter = 0; find_weakened_cycle($test,sub {$counter++}); is($counter,4,'found four cycles (including weakened ones) in $test after second weaken()'); my $a = bless {},'foo'; my $b = bless {},'bar'; $a->{'b'} = $b; $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'); } { *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 package bar; use overload q("") => sub{ return 1 }; Devel-Cycle-1.11/lib/0000755000175000017500000000000011244506726013663 5ustar lsteinlsteinDevel-Cycle-1.11/lib/Devel/0000755000175000017500000000000011244506727014723 5ustar lsteinlsteinDevel-Cycle-1.11/lib/Devel/Cycle.pm0000644000175000017500000003225511244506625016324 0ustar lsteinlsteinpackage Devel::Cycle; # $Id: Cycle.pm,v 1.15 2009/08/24 12:51:02 lstein Exp $ use 5.006001; use strict; use Carp 'croak','carp'; use warnings; use Scalar::Util qw(isweak blessed refaddr reftype); my $SHORT_NAME = 'A'; my %SHORT_NAMES; require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(find_cycle find_weakened_cycle); our @EXPORT_OK = qw($FORMATTING); our $VERSION = '1.11'; our $FORMATTING = 'roasted'; our $QUIET = 0; my %import_args = (-quiet =>1, -raw =>1, -cooked =>1, -roasted=>1); BEGIN { require constant; constant->import( HAVE_PADWALKER => eval { require PadWalker; $PadWalker::VERSION >= 1.0; }); } sub import { my $self = shift; my @args = @_; my %args = map {$_=>1} @args; $QUIET++ if exists $args{-quiet}; $FORMATTING = 'roasted' if exists $args{-roasted}; $FORMATTING = 'raw' if exists $args{-raw}; $FORMATTING = 'cooked' if exists $args{-cooked}; $self->export_to_level(1,$self,grep {!exists $import_args{$_}} @_); } sub find_weakened_cycle { my $ref = shift; my $callback = shift; unless ($callback) { my $counter = 0; $callback = sub { _do_report(++$counter,shift) } } _find_cycle($ref,{},$callback,1,{},()); } sub find_cycle { my $ref = shift; my $callback = shift; unless ($callback) { my $counter = 0; $callback = sub { _do_report(++$counter,shift) } } _find_cycle($ref,{},$callback,0,{},()); } sub _find_cycle { my $current = shift; my $seenit = shift; my $callback = shift; my $inc_weak_refs = shift; my $complain = shift; my @report = @_; return unless ref $current; # note: it seems like you could just do: # # return if isweak($current); # # but strangely the weak flag doesn't seem to survive the copying, # so the test has to happen directly on the reference in the data # structure being scanned. if ($seenit->{refaddr $current}) { $callback->(\@report); return; } $seenit->{refaddr $current}++; _find_cycle_dispatch($current,{%$seenit},$callback,$inc_weak_refs,$complain,@report); } 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"} }; $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]):()])); } } 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}):()])); } } 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])); } } sub _do_report { my $counter = shift; my $path = shift; print "Cycle ($counter):\n"; foreach (@$path) { my ($type,$index,$ref,$value,$is_weak) = @$_; printf("\t%30s => %-30s\n",($is_weak ? 'w-> ' : '')._format_reference($type,$index,$ref,0),_format_reference(undef,undef,$value,1)); } print "\n"; } sub _format_reference { my ($type,$index,$ref,$deref) = @_; $type ||= _get_type($ref); return $ref unless $type; my $suffix = defined $index ? _format_index($type,$index) : ''; if ($FORMATTING eq 'raw') { return $ref.$suffix; } else { my $package = blessed($ref); my $prefix = $package ? ($FORMATTING eq 'roasted' ? "${package}::" : "${package}=" ) : ''; my $sygil = $deref ? '\\' : ''; my $shortname = ($SHORT_NAMES{$ref} ||= $SHORT_NAME++); return $sygil . ($sygil ? '$' : '$$'). $prefix . $shortname . $suffix if $type eq 'SCALAR'; return $sygil . ($sygil ? '@' : '$') . $prefix . $shortname . $suffix if $type eq 'ARRAY'; return $sygil . ($sygil ? '%' : '$') . $prefix . $shortname . $suffix if $type eq 'HASH'; return $sygil . ($sygil ? '&' : '$') . $prefix . $shortname . $suffix if $type eq 'CODE'; } } # why not Scalar::Util::reftype? sub _get_type { my $thingy = shift; return unless ref $thingy; return 'SCALAR' if UNIVERSAL::isa($thingy,'SCALAR') || UNIVERSAL::isa($thingy,'REF'); 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 { my ($type,$index) = @_; return "->[$index]" if $type eq 'ARRAY'; return "->{'$index'}" if $type eq 'HASH'; return " variable $index" if $type eq 'CODE'; return; } 1; __END__ =head1 NAME Devel::Cycle - Find memory cycles in objects =head1 SYNOPSIS #!/usr/bin/perl use Devel::Cycle; my $test = {fred => [qw(a b c d e)], ethel => [qw(1 2 3 4 5)], george => {martha => 23, agnes => 19} }; $test->{george}{phyllis} = $test; $test->{fred}[3] = $test->{george}; $test->{george}{mary} = $test->{fred}; find_cycle($test); exit 0; # output: Cycle (1): $A->{'george'} => \%B $B->{'phyllis'} => \%A Cycle (2): $A->{'george'} => \%B $B->{'mary'} => \@A $A->[3] => \%B Cycle (3): $A->{'fred'} => \@A $A->[3] => \%B $B->{'phyllis'} => \%A Cycle (4): $A->{'fred'} => \@A $A->[3] => \%B $B->{'mary'} => \@A # you can also check weakened references weaken($test->{george}->{phyllis}); find_weakened_cycle($test); exit 0; # output: Cycle (1): $A->{'george'} => \%B $B->{'mary'} => \@C $C->[3] => \%B Cycle (2): $A->{'george'} => \%B w-> $B->{'phyllis'} => \%A Cycle (3): $A->{'fred'} => \@C $C->[3] => \%B $B->{'mary'} => \@C Cycle (4): $A->{'fred'} => \@C $C->[3] => \%B w-> $B->{'phyllis'} => \%A =head1 DESCRIPTION This is a simple developer's tool for finding circular references in objects and other types of references. Because of Perl's reference-count based memory management, circular references will cause memory leaks. =head2 EXPORT The find_cycle() and find_weakened_cycle() subroutine are exported by default. =over 4 =item find_cycle($object_reference,[$callback]) The find_cycle() function will traverse the object reference and print a report to STDOUT identifying any memory cycles it finds. If an optional callback code reference is provided, then this callback will be invoked on each cycle that is found. The callback will be passed an array reference pointing to a list of lists with the following format: $arg = [ ['REFTYPE',$index,$reference,$reference_value], ['REFTYPE',$index,$reference,$reference_value], ['REFTYPE',$index,$reference,$reference_value], ... ] Each element in the array reference describes one edge in the memory cycle. 'REFTYPE' describes the type of the reference and is one of 'SCALAR','ARRAY' or 'HASH'. $index is the index affected by the reference, and is undef for a scalar, an integer for an array reference, or a hash key for a hash. $reference is the memory reference, and $reference_value is its dereferenced value. For example, if the edge is an ARRAY, then the following relationship holds: $reference->[$index] eq $reference_value The first element of the array reference is the $object_reference that you pased to find_cycle() and may not be directly involved in the cycle. If a reference is a weak ref produced using Scalar::Util's weaken() function then it won't contribute to cycles. =item find_weakened_cycle($object_reference,[$callback]) The find_weakened_cycle() function will traverse the object reference and print a report to STDOUT identifying any memory cycles it finds, I any weakened cycles produced using Scalar::Util's weaken(). If an optional callback code reference is provided, then this callback will be invoked on each cycle that is found. The callback will be passed an array reference pointing to a list of lists with the following format: $arg = [ ['REFTYPE',$index,$reference,$reference_value,$is_weakened], ['REFTYPE',$index,$reference,$reference_value,$is_weakened], ['REFTYPE',$index,$reference,$reference_value,$is_weakened], ... ] Each element in the array reference describes one edge in the memory cycle. 'REFTYPE' describes the type of the reference and is one of 'SCALAR','ARRAY' or 'HASH'. $index is the index affected by the reference, and is undef for a scalar, an integer for an array reference, or a hash key for a hash. $reference is the memory reference, and $reference_value is its dereferenced value. $is_weakened is a boolean specifying if the reference is weakened or not. For example, if the edge is an ARRAY, then the following relationship holds: $reference->[$index] eq $reference_value The first element of the array reference is the $object_reference that you pased to find_cycle() and may not be directly involved in the cycle. =back =head2 Cycle Report Formats The default callback prints out a trace of each cycle it finds. You can control the format of the trace by setting the package variable $Devel::Cycle::FORMATTING to one of "raw," "cooked," or "roasted". The "raw" format prints out anonymous memory references using standard Perl memory location nomenclature. For example, a "Foo::Bar" object that points to an ordinary hash will appear in the trace like this: Foo::Bar=HASH(0x8124394)->{'phyllis'} => HASH(0x81b4a90) The "cooked" format (the default), uses short names for anonymous memory locations, beginning with "A" and moving upward with the magic ++ operator. This leads to a much more readable display: $Foo::Bar=B->{'phyllis'} => \%A The "roasted" format is similar to the "cooked" format, except that object references are formatted slightly differently: $Foo::Bar::B->{'phyllis'} => \%A If a reference is a weakened ref, then it will have a 'w->' prepended to it, like this: w-> $Foo::Bar::B->{'phyllis'} => \%A For your convenience, $Devel::Cycle::FORMATTING can be imported: use Devel::Cycle qw(:DEFAULT $FORMATTING); $FORMATTING = 'raw'; Alternatively, you can control the formatting at compile time by passing one of the options -raw, -cooked, or -roasted to "use" as illustrated here: use Devel::Cycle -raw; =head2 Code references (closures) If the PadWalker module is installed, Devel::Cycle will also report cycles in code closures. If PadWalker is not installed and Devel::Cycle detects a CODE reference in one of the data structures, it will warn (once per data structure) that it cannot inspect the CODE unless PadWalker is available. You can turn this warning off by passing -quiet to Devel::Cycle at compile time: use Devel::Cycle -quiet; =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein, Elstein@cshl.eduE =head1 COPYRIGHT AND LICENSE Copyright (C) 2003 by Lincoln Stein This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available. =cut Devel-Cycle-1.11/README0000644000175000017500000000305207766641033014002 0ustar lsteinlsteinDevel-Cycle version 1.00 ======================== This module can be used to find memory cycles in objects and other references. Here is the synopsis: #!/usr/bin/perl use Devel::Cycle; # create an object that has four cycles my $test = {fred => [qw(a b c d e)], ethel => [qw(1 2 3 4 5)], george => {martha => 23, agnes => 19} }; # cycle 1 $test->{george}{phyllis} = $test; # cycle 2 $test->{fred}[3] = $test->{george}; # cycles 3 and 4 $test->{george}{mary} = $test->{fred}; find_cycle($test); exit 0; # output of the script: Cycle (1): HASH(0x8171d30)->{george} => HASH(0x8171d00) HASH(0x8171d00)->{phyllis} => HASH(0x8171d30) Cycle (2): HASH(0x8171d30)->{george} => HASH(0x8171d00) HASH(0x8171d00)->{mary} => ARRAY(0x814be60) ARRAY(0x814be60)->[3] => HASH(0x8171d00) Cycle (3): HASH(0x8171d30)->{fred} => ARRAY(0x814be60) ARRAY(0x814be60)->[3] => HASH(0x8171d00) HASH(0x8171d00)->{phyllis} => HASH(0x8171d30) Cycle (4): HASH(0x8171d30)->{fred} => ARRAY(0x814be60) ARRAY(0x814be60)->[3] => HASH(0x8171d00) HASH(0x8171d00)->{mary} => ARRAY(0x814be60) INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2003 by Lincoln Stein This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available. Devel-Cycle-1.11/Changes0000644000175000017500000000256311244506625014414 0ustar lsteinlsteinRevision history for Perl extension Devel::Cycle. 1.11 Mon Aug 24 08:50:25 EDT 2009 - Florian Ragwitz fixed bug 47389 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. 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! 1.07 Tue May 23 22:28:03 EDT 2006 - Fixed export_to_level() problem so that Test::Memory::Cycle works again. 1.06 Tue May 23 17:08:22 EDT 2006 - Removed debugging warning. - Only checks CODErefs if PadWalker version >= 1.0. 1.05 May 18 2006 - Added ability to detect cycles in CODErefs courtesy Yuval Kogman. 1.04 - Added ability to detect weakened cycles courtesy Stevan Little 1.03 Fri Jan 21 13:47:50 EST 2005 - Sort the hash keys so that the cycle path is more deterministic (avoids test failures in Test::Memory::Cycle) 1.02 Mon Jan 12 09:04:58 EST 2004 - Formats anonymous memory references by default as \%A, \@B, etc, rather than using hex form. - Options to control memory reference formatting. 1.01 Sun Dec 14 16:57:58 EST 2003 - Added code to skip weak refs created with Scalar::Util's weaken(). (Sam Tregar) - Improved formatting in output. 1.00 Sat Dec 13 11:04:57 2003 - original version Devel-Cycle-1.11/Makefile.PL0000644000175000017500000000157511000707103015055 0ustar lsteinlsteinuse 5.006001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Devel::Cycle', VERSION_FROM => 'lib/Devel/Cycle.pm', # finds $VERSION 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 ') : ()), LIBS => [''], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => '-I.', # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too ); Devel-Cycle-1.11/META.yml0000664000175000017500000000073311244506727014374 0ustar lsteinlstein--- #YAML:1.0 name: Devel-Cycle version: 1.11 abstract: Find memory cycles in objects license: ~ author: - Lincoln Stein generated_by: ExtUtils::MakeMaker version 6.42 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 Devel-Cycle-1.11/MANIFEST0000644000175000017500000000022610433135102014227 0ustar lsteinlsteinChanges Makefile.PL MANIFEST README t/Devel-Cycle.t lib/Devel/Cycle.pm META.yml Module meta-data (added by MakeMaker)