Test-Memory-Cycle-1.04/0000755000076600007660000000000010465531460014610 5ustar andyandy00000000000000Test-Memory-Cycle-1.04/Changes0000644000076600007660000000203710465527363016114 0ustar andyandy00000000000000Revision history for Perl extension Test::Memory::Cycle 1.04 Sun Aug 6 22:09:36 CDT 2006 [FIXES] * Updated the minimum version requirements. [ENHANCEMENTS] * Added support for detecting closures. Thanks Yuval Kogman. [INTERNALS] * Internal code optimizations 1.02 Tue May 17 11:22:09 CDT 2005 [ENHANCEMENTS] * Added weakened_memory_cycle_ok() and weakened_memory_cycle_exists(). Thanks, Stevan Little. 1.00 Sun Jan 23 01:00:32 CST 2005 [ENHANCEMENTS] * Added memory_cycle_exists(). Thanks, Stevan Little. 0.04 Tue Mar 9 23:42:26 CST 2004 [FIXES] * t/pod-coverage.t works better now. 0.02 Mon Jan 19 23:01:29 CST 2004 [ENHANCEMENTS] * Cleaned up formatting a bit. [INTERNALS] * Added new tests. 0.01 Sun Nov 30 23:45:27 CST 2003 Brand new, and ready to go. t/family.t doesn't work yet, and it needs more robust testing, but I think it's pretty cool anyway. Test-Memory-Cycle-1.04/Cycle.pm0000644000076600007660000001611410465531043016205 0ustar andyandy00000000000000package Test::Memory::Cycle; use strict; use warnings; =head1 NAME Test::Memory::Cycle - Check for memory leaks and circular memory references =head1 VERSION Version 1.04 =cut our $VERSION = '1.04'; =head1 SYNOPSIS Perl's garbage collection has one big problem: Circular references can't get cleaned up. A circular reference can be as simple as two reference that refer to each other: my $mom = { name => "Marilyn Lester", }; my $me = { name => "Andy Lester", mother => $mom, }; $mom->{son} = $me; C is built on top of C to give you an easy way to check for these circular references. use Test::Memory::Cycle; my $object = new MyObject; # Do stuff with the object. memory_cycle_ok( $object ); You can also use C to make sure that you have a cycle where you expect to have one. =cut use Devel::Cycle qw( find_cycle find_weakened_cycle ); use Test::Builder; my $Test = Test::Builder->new; sub import { my $self = shift; my $caller = caller; no strict 'refs'; *{$caller.'::memory_cycle_ok'} = \&memory_cycle_ok; *{$caller.'::memory_cycle_exists'} = \&memory_cycle_exists; *{$caller.'::weakened_memory_cycle_ok'} = \&weakened_memory_cycle_ok; *{$caller.'::weakened_memory_cycle_exists'} = \&weakened_memory_cycle_exists; *{$caller.'::memory_cycle_exists'} = \&memory_cycle_exists; *{$caller.'::weakened_memory_cycle_ok'} = \&weakened_memory_cycle_ok; *{$caller.'::weakened_memory_cycle_exists'} = \&weakened_memory_cycle_exists; $Test->exported_to($caller); $Test->plan(@_); return; } =head1 FUNCTIONS =head2 C, I<$msg> )> Checks that I<$reference> doesn't have any circular memory references. =cut sub memory_cycle_ok { my $ref = shift; my $msg = shift; my $cycle_no = 0; my @diags; # Callback function that is called once for each memory cycle found. my $callback = sub { my $path = shift; $cycle_no++; push( @diags, "Cycle #$cycle_no" ); foreach (@$path) { my ($type,$index,$ref,$value) = @$_; my $str = 'Unknown! This should never happen!'; my $refdisp = _ref_shortname( $ref ); my $valuedisp = _ref_shortname( $value ); $str = sprintf( ' %s => %s', $refdisp, $valuedisp ) if $type eq 'SCALAR'; $str = sprintf( ' %s => %s', "${refdisp}->[$index]", $valuedisp ) if $type eq 'ARRAY'; $str = sprintf( ' %s => %s', "${refdisp}->{$index}", $valuedisp ) if $type eq 'HASH'; $str = sprintf( ' closure %s => %s', "${refdisp}, $index", $valuedisp ) if $type eq 'CODE'; push( @diags, $str ); } }; find_cycle( $ref, $callback ); my $ok = !$cycle_no; $Test->ok( $ok, $msg ); $Test->diag( join( "\n", @diags, '' ) ) unless $ok; return $ok; } # memory_cycle_ok =head2 C, I<$msg> )> Checks that I<$reference> B have any circular memory references. =cut sub memory_cycle_exists { my $ref = shift; my $msg = shift; my $cycle_no = 0; # Callback function that is called once for each memory cycle found. my $callback = sub { $cycle_no++ }; find_cycle( $ref, $callback ); my $ok = $cycle_no; $Test->ok( $ok, $msg ); return $ok; } # memory_cycle_exists =head2 C, I<$msg> )> Checks that I<$reference> doesn't have any circular memory references, but unlike C this will also check for weakened cycles produced with Scalar::Util's C. =cut sub weakened_memory_cycle_ok { my $ref = shift; my $msg = shift; my $cycle_no = 0; my @diags; # Callback function that is called once for each memory cycle found. my $callback = sub { my $path = shift; $cycle_no++; push( @diags, "Cycle #$cycle_no" ); foreach (@$path) { my ($type,$index,$ref,$value,$is_weakened) = @$_; my $str = "Unknown! This should never happen!"; my $refdisp = _ref_shortname( $ref ); my $valuedisp = _ref_shortname( $value ); my $weak = $is_weakened ? 'w->' : ''; $str = sprintf( ' %s%s => %s', $weak, $refdisp, $valuedisp ) if $type eq 'SCALAR'; $str = sprintf( ' %s%s => %s', $weak, "${refdisp}->[$index]", $valuedisp ) if $type eq 'ARRAY'; $str = sprintf( ' %s%s => %s', $weak, "${refdisp}->{$index}", $valuedisp ) if $type eq 'HASH'; push( @diags, $str ); } }; find_weakened_cycle( $ref, $callback ); my $ok = !$cycle_no; $Test->ok( $ok, $msg ); $Test->diag( join( "\n", @diags, "" ) ) unless $ok; return $ok; } # weakened_memory_cycle_ok =head2 C, I<$msg> )> Checks that I<$reference> B have any circular memory references, but unlike C this will also check for weakened cycles produced with Scalar::Util's C. =cut sub weakened_memory_cycle_exists { my $ref = shift; my $msg = shift; my $cycle_no = 0; # Callback function that is called once for each memory cycle found. my $callback = sub { $cycle_no++ }; find_weakened_cycle( $ref, $callback ); my $ok = $cycle_no; $Test->ok( $ok, $msg ); return $ok; } # weakened_memory_cycle_exists my %shortnames; my $new_shortname = "A"; sub _ref_shortname { my $ref = shift; my $refstr = "$ref"; my $refdisp = $shortnames{ $refstr }; if ( !$refdisp ) { my $sigil = ref($ref) . " "; $sigil = '%' if $sigil eq "HASH "; $sigil = '@' if $sigil eq "ARRAY "; $sigil = '$' if $sigil eq "REF "; $sigil = '&' if $sigil eq "CODE "; $refdisp = $shortnames{ $refstr } = $sigil . $new_shortname++; } return $refdisp; } =head1 AUTHOR Written by Andy Lester, C<< >>. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Test::Memory::Cycle You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Thanks to the contributions of Stevan Little, and to Lincoln Stein for writing Devel::Cycle. =head1 COPYRIGHT Copyright 2006, Andy Lester, All Rights Reserved. You may use, modify, and distribute this package under the same terms as Perl itself. =cut 1; Test-Memory-Cycle-1.04/Makefile.PL0000644000076600007660000000131210465526210016554 0ustar andyandy00000000000000use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::Memory::Cycle', VERSION_FROM => 'Cycle.pm', # finds $VERSION ABSTRACT => "Verifies code hasn't left circular references", PREREQ_PM => { 'Devel::Cycle' => 1.07, # for weakened ref checking 'Getopt::Long' => 0, 'PadWalker' => 0, 'Test::Builder' => 0, 'Test::Builder::Tester' => 0, 'Test::More' => 0, 'Test::Simple' => 0.62, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Test-Memory-Cycle-*' }, ); Test-Memory-Cycle-1.04/MANIFEST0000644000076600007660000000040110465531460015734 0ustar andyandy00000000000000Changes Cycle.pm MANIFEST Makefile.PL README t/00-load.t t/cycle-exists.t t/family-array.t t/family-hash.t t/family-object.t t/family-scalar.t t/good.t t/pod-coverage.t t/pod.t META.yml Module meta-data (added by MakeMaker) Test-Memory-Cycle-1.04/META.yml0000644000076600007660000000122210465531460016056 0ustar andyandy00000000000000--- #YAML:1.0 name: Test-Memory-Cycle version: 1.04 abstract: Verifies code hasn't left circular references license: unknown generated_by: ExtUtils::MakeMaker version 6.30_01 author: ~ distribution_type: module requires: Devel::Cycle: 1.07 Getopt::Long: 0 PadWalker: 0 Test::Builder: 0 Test::Builder::Tester: 0 Test::More: 0 Test::Simple: 0.62 meta-spec: url: ; version: 1.1 Test-Memory-Cycle-1.04/README0000644000076600007660000000012110465526210015457 0ustar andyandy00000000000000A thin Test::More-compatible wrapper around Lincoln Stein's Devel::Cycle module. Test-Memory-Cycle-1.04/t/0000755000076600007660000000000010465531457015061 5ustar andyandy00000000000000Test-Memory-Cycle-1.04/t/00-load.t0000644000076600007660000000030110465526506016373 0ustar andyandy00000000000000#!perl -Tw use Test::More tests => 1; use_ok( 'Test::Memory::Cycle' ); diag( "Testing Test::Memory::Cycle $Test::Memory::Cycle::VERSION under Perl $] and Test::More $Test::More::VERSION" ); Test-Memory-Cycle-1.04/t/cycle-exists.t0000644000076600007660000000221110465526210017645 0ustar andyandy00000000000000#!perl -T use strict; use Test::Builder::Tester tests => 5; use Test::More; BEGIN { use_ok( 'Test::Memory::Cycle' ); } { my $cycle_less_hash = {}; test_out( "not ok 1 - A hash reference has no cycles" ); test_fail( +1 ); memory_cycle_exists( $cycle_less_hash, "A hash reference has no cycles" ); test_test( "Testing for lack of cycles in hash reference" ); } { my $cycle_less_array = []; test_out( "not ok 1 - An array reference has no cycles" ); test_fail( +1 ); memory_cycle_exists( $cycle_less_array, "An array reference has no cycles" ); test_test( "Testing for lack of cycles in array reference" ); } { my $var = 0; my $cycle_less_scalar = \$var; test_out( "not ok 1 - A scalar reference has no cycles" ); test_fail( +1 ); memory_cycle_exists( $cycle_less_scalar, "A scalar reference has no cycles" ); test_test( "Testing for lack of cycles in scalar reference" ); } { my $cycle_less_object = bless({}, 'NoCyclesHere'); test_out( "not ok 1 - A blessed reference has no cycles" ); test_fail( +1 ); memory_cycle_exists( $cycle_less_object, "A blessed reference has no cycles" ); test_test( "Testing for lack of cycles in blessed reference" ); } Test-Memory-Cycle-1.04/t/family-array.t0000644000076600007660000000512310465526210017633 0ustar andyandy00000000000000#!perl -T use strict; use warnings FATAL => 'all'; use Scalar::Util qw( weaken ); use Test::More tests => 7; use Test::Builder::Tester; BEGIN { use_ok( 'Test::Memory::Cycle' ); } my $mom = { name => "Marilyn Lester", }; my $dad = { name => "Dan Lester", }; my $me = { name => "Andy Lester", parents => [$mom,$dad], }; my $andy = $me; my $amy = { name => "Amy Lester", }; my $quinn = { name => "Quinn Lester", parents => [$andy,$amy], }; $mom->{children} = [$andy]; $mom->{grandchildren} = [$quinn]; test_out( "not ok 1 - The Array Family" ); test_fail( +13 ); test_diag( 'Cycle #1' ); test_diag( ' %A->{parents} => @B' ); test_diag( ' @B->[0] => %C' ); test_diag( ' %C->{children} => @D' ); test_diag( ' @D->[0] => %A' ); test_diag( 'Cycle #2' ); test_diag( ' %A->{parents} => @B' ); test_diag( ' @B->[0] => %C' ); test_diag( ' %C->{grandchildren} => @E' ); test_diag( ' @E->[0] => %F' ); test_diag( ' %F->{parents} => @G' ); test_diag( ' @G->[0] => %A' ); memory_cycle_ok( $me, "The Array Family" ); test_test( "Array family testing" ); test_out( "ok 1 - The Array Family has Cycles" ); memory_cycle_exists( $me, "The Array Family has Cycles" ); test_test( "Array family testing for cycles" ); weaken($me->{parents}->[0]->{children}->[0]); weaken($me->{parents}->[0]->{grandchildren}->[0]->{parents}->[0]); test_out( "ok 1 - The Array Family (weakened)" ); memory_cycle_ok( $me, "The Array Family (weakened)" ); test_test( "Array family (weakened) testing (no cycles)" ); test_out( "not ok 1 - The Array Family (weakened)" ); test_fail( +13 ); test_diag( 'Cycle #1' ); test_diag( ' %A->{parents} => @B' ); test_diag( ' @B->[0] => %C' ); test_diag( ' %C->{children} => @D' ); test_diag( ' w->@D->[0] => %A' ); test_diag( 'Cycle #2' ); test_diag( ' %A->{parents} => @B' ); test_diag( ' @B->[0] => %C' ); test_diag( ' %C->{grandchildren} => @E' ); test_diag( ' @E->[0] => %F' ); test_diag( ' %F->{parents} => @G' ); test_diag( ' w->@G->[0] => %A' ); weakened_memory_cycle_ok( $me, "The Array Family (weakened)" ); test_test( "Array family (weakened) testing (weakened cycles showing)" ); test_out( "not ok 1 - The Array Family (weakened) has Cycles" ); test_fail( +1 ); memory_cycle_exists( $me, "The Array Family (weakened) has Cycles" ); test_test( "Array family (weakened) testing for cycles (no cycles)" ); test_out( "ok 1 - The Array Family (weakened) has Cycles" ); weakened_memory_cycle_exists( $me, "The Array Family (weakened) has Cycles" ); test_test( "Array family (weakened) testing for cycles (weakened cycles showing)" ); Test-Memory-Cycle-1.04/t/family-hash.t0000644000076600007660000000314010465526210017435 0ustar andyandy00000000000000#!perl -T use strict; use warnings FATAL => 'all'; use Scalar::Util qw( weaken ); use Test::More tests => 7; use Test::Builder::Tester; BEGIN { use_ok( 'Test::Memory::Cycle' ); } my $mom = { name => "Marilyn Lester", }; my $me = { name => "Andy Lester", mother => $mom, }; $mom->{son} = $me; test_out( "not ok 1 - Small family" ); test_fail( +4 ); test_diag( 'Cycle #1' ); test_diag( ' %A->{mother} => %B' ); test_diag( ' %B->{son} => %A' ); memory_cycle_ok( $me, "Small family" ); test_test( "Small family testing" ); test_out( "ok 1 - Small family has Cycles" ); memory_cycle_exists( $me, "Small family has Cycles" ); test_test( "Small family testing for cycles" ); weaken($me->{mother}->{son}); test_out( "ok 1 - Small family (weakened)" ); memory_cycle_ok( $me, "Small family (weakened)" ); test_test( "Small family (weakened) testing (no cycles)" ); test_out( "not ok 1 - Small family (weakened)" ); test_fail( +4 ); test_diag( 'Cycle #1' ); test_diag( ' %A->{mother} => %B' ); test_diag( ' w->%B->{son} => %A' ); weakened_memory_cycle_ok( $me, "Small family (weakened)" ); test_test( "Small family (weakened) testing for cycles (weakened cycles found)" ); test_out( "not ok 1 - Small family (weakened) has Cycles" ); test_fail( +1 ); memory_cycle_exists( $me, "Small family (weakened) has Cycles" ); test_test( "Small family (weakened) testing for cycles (no cycles)" ); test_out( "ok 1 - Small family (weakened) has Cycles" ); weakened_memory_cycle_exists( $me, "Small family (weakened) has Cycles" ); test_test( "Small family (weakened) testing for cycles (weakened cycles found)" );Test-Memory-Cycle-1.04/t/family-object.t0000644000076600007660000000250710465526210017766 0ustar andyandy00000000000000#!perl -T use strict; use warnings FATAL => 'all'; use Test::More tests => 3; use Test::Builder::Tester; use Getopt::Long; BEGIN { use_ok( 'Test::Memory::Cycle' ); } my $dis = Getopt::Long::Parser->new; my $dat = Getopt::Long::Parser->new; $dis->{dose} = [$dat,$dat,$dat]; $dat->{dem} = { dis => $dis }; test_out( "not ok 1 - Object family" ); test_fail( +16 ); test_diag( 'Cycle #1' ); test_diag( ' Getopt::Long::Parser A->{dose} => @B' ); test_diag( ' @B->[0] => Getopt::Long::Parser C' ); test_diag( ' Getopt::Long::Parser C->{dem} => %D' ); test_diag( ' %D->{dis} => Getopt::Long::Parser A' ); test_diag( 'Cycle #2' ); test_diag( ' Getopt::Long::Parser A->{dose} => @B' ); test_diag( ' @B->[1] => Getopt::Long::Parser C' ); test_diag( ' Getopt::Long::Parser C->{dem} => %D' ); test_diag( ' %D->{dis} => Getopt::Long::Parser A' ); test_diag( 'Cycle #3' ); test_diag( ' Getopt::Long::Parser A->{dose} => @B' ); test_diag( ' @B->[2] => Getopt::Long::Parser C' ); test_diag( ' Getopt::Long::Parser C->{dem} => %D' ); test_diag( ' %D->{dis} => Getopt::Long::Parser A' ); memory_cycle_ok( $dis, "Object family" ); test_test( "Object family testing" ); test_out( "ok 1 - Object family has Cycles" ); memory_cycle_exists( $dis, "Object family has Cycles" ); test_test( "Object family testing with cycles" ); Test-Memory-Cycle-1.04/t/family-scalar.t0000644000076600007660000000531110465526210017761 0ustar andyandy00000000000000#!perl -T use strict; use warnings FATAL => 'all'; use Scalar::Util qw( weaken ); use Test::More tests => 12; use Test::Builder::Tester; BEGIN { use_ok( 'Test::Memory::Cycle' ); } my $me; $me = \$me; test_out( "not ok 1 - Scalar Family" ); test_fail( +3 ); test_diag( 'Cycle #1' ); test_diag( ' $A => $A' ); memory_cycle_ok( $me, "Scalar Family" ); test_test( "Simple loopback" ); test_out( "ok 1 - Scalar Family has Cycles" ); memory_cycle_exists( $me, "Scalar Family has Cycles" ); test_test( "Simple loopback testing for cycles" ); my $myself = \$me; $me = \$myself; test_out( "not ok 1" ); test_fail( +4 ); test_diag( 'Cycle #1' ); test_diag( ' $A => $B' ); test_diag( ' $B => $A' ); memory_cycle_ok( $myself ); # Test non-comments test_test( "Simple loopback to myself" ); test_out( "ok 1" ); memory_cycle_exists( $myself ); # Test non-comments test_test( "Simple loopback to myself with cycles" ); # Order matters test_out( "not ok 1" ); test_fail( +4 ); test_diag( 'Cycle #1' ); test_diag( ' $B => $A' ); test_diag( ' $A => $B' ); memory_cycle_ok( $me ); # Test non-comments test_test( "Flip-flopped the A/B" ); my $sybil; $sybil = [ $sybil, \$sybil, $me, \$sybil ]; test_out( "not ok 1" ); test_fail( +11 ); test_diag( 'Cycle #1' ); test_diag( ' @C->[1] => $D' ); test_diag( ' $D => @C' ); test_diag( 'Cycle #2' ); test_diag( ' @C->[2] => $B' ); test_diag( ' $B => $A' ); test_diag( ' $A => $B' ); test_diag( 'Cycle #3' ); test_diag( ' @C->[3] => $D' ); test_diag( ' $D => @C' ); memory_cycle_ok( $sybil ); # Test non-comments test_test( "Sybil and her sisters" ); test_out( "ok 1" ); memory_cycle_exists( $sybil ); # Test non-comments test_test( "Sybil and her sisters have cycles" ); weaken($sybil->[1]); weaken($sybil->[2]); weaken($sybil->[3]); test_out( "ok 1" ); memory_cycle_ok( $sybil ); # Test non-comments test_test( "Sybil and her sisters (weakened) (no cycles found)" ); test_out( "not ok 1" ); test_fail( +11 ); test_diag( 'Cycle #1' ); test_diag( ' w->@C->[1] => $D' ); test_diag( ' $D => @C' ); test_diag( 'Cycle #2' ); test_diag( ' w->@C->[2] => $B' ); test_diag( ' $B => $A' ); test_diag( ' $A => $B' ); test_diag( 'Cycle #3' ); test_diag( ' w->@C->[3] => $D' ); test_diag( ' $D => @C' ); weakened_memory_cycle_ok( $sybil ); # Test non-comments test_test( "Sybil and her sisters (weakened) (weakened cycles found)" ); test_out( "not ok 1" ); test_fail( +1 ); memory_cycle_exists( $sybil ); # Test non-comments test_test( "Sybil and her sisters (weakened) have cycles (no cycles found)" ); test_out( "ok 1" ); weakened_memory_cycle_exists( $sybil ); # Test non-comments test_test( "Sybil and her sisters (weakened) have cycles (weakened cycles found)" ); Test-Memory-Cycle-1.04/t/good.t0000644000076600007660000000033310465526210016164 0ustar andyandy00000000000000#!perl -T use strict; use Test::Builder::Tester tests => 2; use Test::More; use CGI; BEGIN { use_ok( 'Test::Memory::Cycle' ); } GOOD: { my $cgi = new CGI; memory_cycle_ok( $cgi, "CGI doesn't leak" ); } Test-Memory-Cycle-1.04/t/pod-coverage.t0000644000076600007660000000025510465526210017612 0ustar andyandy00000000000000#!perl -Tw use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Test-Memory-Cycle-1.04/t/pod.t0000644000076600007660000000021510465526210016015 0ustar andyandy00000000000000#!perl -Tw use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();