r30577 - in /branches/upstream/libtest-memory-cycle-perl: ./ current/ current/t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Wed Feb 11 04:53:18 UTC 2009
Author: ryan52-guest
Date: Wed Feb 11 04:53:00 2009
New Revision: 30577
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30577
Log:
[svn-inject] Installing original source of libtest-memory-cycle-perl
Added:
branches/upstream/libtest-memory-cycle-perl/
branches/upstream/libtest-memory-cycle-perl/current/
branches/upstream/libtest-memory-cycle-perl/current/Changes
branches/upstream/libtest-memory-cycle-perl/current/Cycle.pm
branches/upstream/libtest-memory-cycle-perl/current/MANIFEST
branches/upstream/libtest-memory-cycle-perl/current/META.yml
branches/upstream/libtest-memory-cycle-perl/current/Makefile.PL
branches/upstream/libtest-memory-cycle-perl/current/README
branches/upstream/libtest-memory-cycle-perl/current/t/
branches/upstream/libtest-memory-cycle-perl/current/t/00-load.t
branches/upstream/libtest-memory-cycle-perl/current/t/cycle-exists.t
branches/upstream/libtest-memory-cycle-perl/current/t/family-array.t
branches/upstream/libtest-memory-cycle-perl/current/t/family-hash.t
branches/upstream/libtest-memory-cycle-perl/current/t/family-object.t
branches/upstream/libtest-memory-cycle-perl/current/t/family-scalar.t
branches/upstream/libtest-memory-cycle-perl/current/t/good.t
branches/upstream/libtest-memory-cycle-perl/current/t/pod-coverage.t
branches/upstream/libtest-memory-cycle-perl/current/t/pod.t
Added: branches/upstream/libtest-memory-cycle-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/Changes?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/Changes (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/Changes Wed Feb 11 04:53:00 2009
@@ -1,0 +1,40 @@
+Revision 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.
Added: branches/upstream/libtest-memory-cycle-perl/current/Cycle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/Cycle.pm?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/Cycle.pm (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/Cycle.pm Wed Feb 11 04:53:00 2009
@@ -1,0 +1,280 @@
+package 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<Test::Memory::Cycle> is built on top of C<Devel::Cycle> 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<memory_cycle_exists()> 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<memory_cycle_ok( I<$reference>, 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<memory_cycle_exists( I<$reference>, I<$msg> )>
+
+Checks that I<$reference> B<does> 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<weakened_memory_cycle_ok( I<$reference>, I<$msg> )>
+
+Checks that I<$reference> doesn't have any circular memory references, but unlike
+C<memory_cycle_ok> this will also check for weakened cycles produced with
+Scalar::Util's C<weaken>.
+
+=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<weakened_memory_cycle_exists( I<$reference>, I<$msg> )>
+
+Checks that I<$reference> B<does> have any circular memory references, but unlike
+C<memory_cycle_exists> this will also check for weakened cycles produced with
+Scalar::Util's C<weaken>.
+
+=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<< <andy @ petdance.com> >>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-test-memory-cycle at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Memory-Cycle>.
+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<http://annocpan.org/dist/Test-Memory-Cycle>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Test-Memory-Cycle>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Memory-Cycle>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Test-Memory-Cycle>
+
+=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;
Added: branches/upstream/libtest-memory-cycle-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/MANIFEST?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/MANIFEST Wed Feb 11 04:53:00 2009
@@ -1,0 +1,16 @@
+Changes
+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)
Added: branches/upstream/libtest-memory-cycle-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/META.yml?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/META.yml (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/META.yml Wed Feb 11 04:53:00 2009
@@ -1,0 +1,19 @@
+--- #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: <http://module-build.sourceforge.net/META-spec-new.html>;
+ version: 1.1
Added: branches/upstream/libtest-memory-cycle-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/Makefile.PL?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/Makefile.PL Wed Feb 11 04:53:00 2009
@@ -1,0 +1,20 @@
+use 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-*' },
+);
Added: branches/upstream/libtest-memory-cycle-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/README?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/README (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/README Wed Feb 11 04:53:00 2009
@@ -1,0 +1,2 @@
+A thin Test::More-compatible wrapper around Lincoln Stein's
+Devel::Cycle module.
Added: branches/upstream/libtest-memory-cycle-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/00-load.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/00-load.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/00-load.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,7 @@
+#!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" );
Added: branches/upstream/libtest-memory-cycle-perl/current/t/cycle-exists.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/cycle-exists.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/cycle-exists.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/cycle-exists.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,45 @@
+#!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" );
+}
+
+
Added: branches/upstream/libtest-memory-cycle-perl/current/t/family-array.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/family-array.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/family-array.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/family-array.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,93 @@
+#!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)" );
Added: branches/upstream/libtest-memory-cycle-perl/current/t/family-hash.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/family-hash.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/family-hash.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/family-hash.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,58 @@
+#!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)" );
Added: branches/upstream/libtest-memory-cycle-perl/current/t/family-object.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/family-object.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/family-object.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/family-object.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,42 @@
+#!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" );
Added: branches/upstream/libtest-memory-cycle-perl/current/t/family-scalar.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/family-scalar.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/family-scalar.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/family-scalar.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,106 @@
+#!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)" );
+
Added: branches/upstream/libtest-memory-cycle-perl/current/t/good.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/good.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/good.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/good.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,17 @@
+#!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" );
+}
Added: branches/upstream/libtest-memory-cycle-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/pod-coverage.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/pod-coverage.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,6 @@
+#!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();
Added: branches/upstream/libtest-memory-cycle-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-memory-cycle-perl/current/t/pod.t?rev=30577&op=file
==============================================================================
--- branches/upstream/libtest-memory-cycle-perl/current/t/pod.t (added)
+++ branches/upstream/libtest-memory-cycle-perl/current/t/pod.t Wed Feb 11 04:53:00 2009
@@ -1,0 +1,6 @@
+#!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();
More information about the Pkg-perl-cvs-commits
mailing list