r34829 - in /branches/upstream/libtest-refcount-perl: ./ current/ current/lib/ current/lib/Test/ current/t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed May 6 02:41:15 UTC 2009
Author: jawnsy-guest
Date: Wed May 6 02:41:09 2009
New Revision: 34829
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34829
Log:
[svn-inject] Installing original source of libtest-refcount-perl
Added:
branches/upstream/libtest-refcount-perl/
branches/upstream/libtest-refcount-perl/current/
branches/upstream/libtest-refcount-perl/current/Build.PL
branches/upstream/libtest-refcount-perl/current/MANIFEST
branches/upstream/libtest-refcount-perl/current/META.yml
branches/upstream/libtest-refcount-perl/current/Makefile.PL
branches/upstream/libtest-refcount-perl/current/lib/
branches/upstream/libtest-refcount-perl/current/lib/Test/
branches/upstream/libtest-refcount-perl/current/lib/Test/Refcount.pm
branches/upstream/libtest-refcount-perl/current/t/
branches/upstream/libtest-refcount-perl/current/t/00use.t
branches/upstream/libtest-refcount-perl/current/t/01count.t
branches/upstream/libtest-refcount-perl/current/t/02one.t
branches/upstream/libtest-refcount-perl/current/t/03weak.t
branches/upstream/libtest-refcount-perl/current/t/04reftypes.t
Added: branches/upstream/libtest-refcount-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/Build.PL?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/Build.PL (added)
+++ branches/upstream/libtest-refcount-perl/current/Build.PL Wed May 6 02:41:09 2009
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+
+use Module::Build;
+
+my $build = Module::Build->new
+ (
+ module_name => 'Test::Refcount',
+ requires => {
+ 'Devel::FindRef' => 0,
+ 'Devel::Refcount' => 0,
+ 'Test::Builder' => 0,
+ },
+ build_requires => {
+ 'Test::Builder::Tester' => 0,
+ 'Test::More' => 0,
+ },
+ license => 'perl',
+ create_makefile_pl => 'traditional',
+ );
+
+$build->create_build_script;
Added: branches/upstream/libtest-refcount-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/MANIFEST?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-refcount-perl/current/MANIFEST Wed May 6 02:41:09 2009
@@ -1,0 +1,10 @@
+Build.PL
+lib/Test/Refcount.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+t/00use.t
+t/01count.t
+t/02one.t
+t/03weak.t
+t/04reftypes.t
Added: branches/upstream/libtest-refcount-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/META.yml?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/META.yml (added)
+++ branches/upstream/libtest-refcount-perl/current/META.yml Wed May 6 02:41:09 2009
@@ -1,0 +1,24 @@
+---
+name: Test-Refcount
+version: 0.04
+author:
+ - 'Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>'
+abstract: assert reference counts on objects
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ Devel::FindRef: 0
+ Devel::Refcount: 0
+ Test::Builder: 0
+build_requires:
+ Test::Builder::Tester: 0
+ Test::More: 0
+provides:
+ Test::Refcount:
+ file: lib/Test/Refcount.pm
+ version: 0.04
+generated_by: Module::Build version 0.280801
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libtest-refcount-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/Makefile.PL?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-refcount-perl/current/Makefile.PL Wed May 6 02:41:09 2009
@@ -1,0 +1,18 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'Test::Refcount',
+ 'VERSION_FROM' => 'lib/Test/Refcount.pm',
+ 'PREREQ_PM' => {
+ 'Devel::FindRef' => 0,
+ 'Devel::Refcount' => 0,
+ 'Test::Builder' => 0,
+ 'Test::Builder::Tester' => 0,
+ 'Test::More' => 0
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libtest-refcount-perl/current/lib/Test/Refcount.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/lib/Test/Refcount.pm?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/lib/Test/Refcount.pm (added)
+++ branches/upstream/libtest-refcount-perl/current/lib/Test/Refcount.pm Wed May 6 02:41:09 2009
@@ -1,0 +1,213 @@
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License (the same terms as Perl itself)
+#
+# (C) Paul Evans, 2008 -- leonerd at leonerd.org.uk
+
+package Test::Refcount;
+
+use strict;
+use base qw( Test::Builder::Module );
+
+use Scalar::Util qw( weaken );
+
+use Devel::Refcount qw( refcount );
+use Devel::FindRef;
+
+our $VERSION = '0.04';
+
+our @EXPORT = qw(
+ is_refcount
+ is_oneref
+);
+
+=head1 NAME
+
+C<Test::Refcount> - assert reference counts on objects
+
+=head1 SYNOPSIS
+
+ use Test::More tests => 2;
+ use Test::Refcount;
+
+ use Some::Class;
+
+ my $object = Some::Class->new();
+
+ is_oneref( $object, '$object has a refcount of 1' );
+
+ my $otherref = $object;
+
+ is_refcount( $object, 2, '$object now has 2 references' );
+
+=head1 DESCRIPTION
+
+The Perl garbage collector uses simple reference counting during the normal
+execution of a program. This means that cycles or unweakened references in
+other parts of code can keep an object around for longer than intended. To
+help avoid this problem, the reference count of a new object from its class
+constructor ought to be 1. This way, the caller can know the object will be
+properly DESTROYed when it drops all of its references to it.
+
+This module provides two test functions to help ensure this property holds
+for an object class, so as to be polite to its callers.
+
+If the assertion fails; that is, if the actual reference count is different to
+what was expected, a trace of references to the object is printed, using
+Marc Lehmann's L<Devel::FindRef> module. See the examples below for more
+information.
+
+=cut
+
+=head1 FUNCTIONS
+
+=cut
+
+=head2 is_refcount( $object, $count, $name )
+
+Test that $object has $count references to it.
+
+=cut
+
+sub is_refcount($$;$)
+{
+ my ( $object, $count, $name ) = @_;
+ @_ = ();
+
+ my $tb = __PACKAGE__->builder;
+
+ if( !ref $object ) {
+ my $ok = $tb->ok( 0, $name );
+ $tb->diag( " expected a reference, was not given one" );
+ return $ok;
+ }
+
+ weaken $object; # So this reference itself doesn't show up
+
+ my $REFCNT = refcount($object);
+
+ my $ok = $tb->ok( $REFCNT == $count, $name );
+
+ unless( $ok ) {
+ $tb->diag( " expected $count references, found $REFCNT" );
+ $tb->diag( Devel::FindRef::track( $object ) );
+ }
+
+ return $ok;
+}
+
+=head2 is_oneref( $object, $name )
+
+Assert that the $object has only 1 reference to it.
+
+=cut
+
+sub is_oneref($;$)
+{
+ splice( @_, 1, 0, ( 1 ) );
+ goto &is_refcount;
+}
+
+# Keep perl happy; keep Britain tidy
+1;
+
+__END__
+
+=head1 EXAMPLE
+
+Suppose, having written a new class C<MyBall>, you now want to check that its
+constructor and methods are well-behaved, and don't leak references. Consider
+the following test script:
+
+ use Test::More tests => 2;
+ use Test::Refcount;
+
+ use MyBall;
+
+ my $ball = MyBall->new();
+ is_oneref( $ball, 'One reference after construct' );
+
+ $ball->bounce;
+
+ # Any other code here that might be part of the test script
+
+ is_oneref( $ball, 'One reference just before EOF' );
+
+The first assertion is just after the constructor, to check that the reference
+returned by it is the only reference to that object. This fact is important if
+we ever want C<DESTROY> to behave properly. The second call is right at the
+end of the file, just before the main scope closes. At this stage we expect
+the reference count also to be one, so that the object is properly cleaned up.
+
+Suppose, when run, this produces the following output:
+
+ 1..2
+ ok 1 - One reference after construct
+ not ok 2 - One reference just before EOF
+ # Failed test 'One reference just before EOF'
+ # at demo.pl line 16.
+ # expected 1 references, found 2
+ # MyBall=ARRAY(0x817f880) is
+ # +- referenced by REF(0x82c1fd8), which is
+ # | in the member 'self' of HASH(0x82c1f68), which is
+ # | referenced by REF(0x81989d0), which is
+ # | in the member 'cycle' of HASH(0x82c1f68), which was seen before.
+ # +- referenced by REF(0x82811d0), which is
+ # in the lexical '$ball' in CODE(0x817fa00), which is
+ # the main body of the program.
+ # Looks like you failed 1 test of 2.
+
+From this output, we can see that the constructor was well-behaved, but that a
+reference was leaked by the end of the script - the reference count was 2,
+when we expected just 1. Reading the trace output, we can see that there were
+2 references that C<Devel::FindRef> could find - one stored in the $ball
+lexical in the main program, and one stored in a HASH. Since we expected to
+find the $ball lexical variable, we know we are now looking for a leak in a
+hash somewhere in the code. From reading the test script, we can guess this
+leak is likely to be in the bounce() method. Furthermore, we know that the
+reference to the object will be stored in a HASH in a member called C<self>.
+
+By reading the code which implements the bounce() method, we can see this is
+indeed the case:
+
+ sub bounce
+ {
+ my $self = shift;
+ my $cycle = { self => $self };
+ $cycle->{cycle} = $cycle;
+ }
+
+From reading the C<Devel::FindRef> output, we find that the HASH this object
+is referenced in also contains a reference to itself, in a member called
+C<cycle>. This comes from the last line in this function, a line that
+purposely created a cycle, to demonstrate the point. While a real program
+probably wouldn't do anything quite this obvious, the trace would still be
+useful in finding the likely cause of the leak.
+
+=head1 BUGS
+
+=over 4
+
+=item * Temporaries created on the stack
+
+Code which creates temporaries on the stack, to be released again when the
+called function returns does not work correctly on perl 5.8 (and probably
+before). Examples such as
+
+ is_oneref( [] );
+
+may fail and claim a reference count of 2 instead.
+
+Passing a variable such as
+
+ my $array = [];
+ is_oneref( $array );
+
+works fine. Because of the intention of this test module; that is, to assert
+reference counts on some object stored in a variable during the lifetime of
+the test script, this is unlikely to cause any problems.
+
+=back
+
+=head1 AUTHOR
+
+Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>
Added: branches/upstream/libtest-refcount-perl/current/t/00use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/t/00use.t?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/t/00use.t (added)
+++ branches/upstream/libtest-refcount-perl/current/t/00use.t Wed May 6 02:41:09 2009
@@ -1,0 +1,5 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 1;
+
+use_ok( "Test::Refcount" );
Added: branches/upstream/libtest-refcount-perl/current/t/01count.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/t/01count.t?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/t/01count.t (added)
+++ branches/upstream/libtest-refcount-perl/current/t/01count.t Wed May 6 02:41:09 2009
@@ -1,0 +1,61 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder::Tester tests => 8;
+
+use Test::Refcount;
+
+my $anon = [];
+
+test_out( "ok 1 - anon ARRAY ref" );
+is_refcount( $anon, 1, 'anon ARRAY ref' );
+test_test( "anon ARRAY ref succeeds" );
+
+test_out( "not ok 1 - not ref" );
+test_fail( +2 );
+test_err( "# expected a reference, was not given one" );
+is_refcount( "hello", 1, 'not ref' );
+test_test( "not ref fails" );
+
+my $object = bless {}, "Some::Class";
+
+test_out( "ok 1 - object" );
+is_refcount( $object, 1, 'object' );
+test_test( "normal object succeeds" );
+
+my $newref = $object;
+
+test_out( "ok 1 - two refs" );
+is_refcount( $object, 2, 'two refs' );
+test_test( "two refs to object succeeds" );
+
+test_out( "not ok 1 - one ref" );
+test_fail( +4 );
+test_err( "# expected 1 references, found 2" );
+test_err( qr/^# Some::Class=HASH\(0x[0-9a-f]+\) (?:\[refcount 2\] )?is\n/ );
+test_err( qr/(?:^#.*\n){1,}/m ); # Don't be sensitive on what Devel::FindRef actually prints
+is_refcount( $object, 1, 'one ref' );
+test_test( "two refs to object fails to be 1" );
+
+undef $newref;
+
+$object->{self} = $object;
+
+test_out( "ok 1 - circular" );
+is_refcount( $object, 2, 'circular' );
+test_test( "circular object succeeds" );
+
+undef $object->{self};
+
+my $otherobject = bless { firstobject => $object }, "Other::Class";
+
+test_out( "ok 1 - other ref to object" );
+is_refcount( $object, 2, 'other ref to object' );
+test_test( "object with another reference succeeds" );
+
+undef $otherobject;
+
+test_out( "ok 1 - undefed other ref to object" );
+is_refcount( $object, 1, 'undefed other ref to object' );
+test_test( "object with another reference undefed succeeds" );
Added: branches/upstream/libtest-refcount-perl/current/t/02one.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/t/02one.t?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/t/02one.t (added)
+++ branches/upstream/libtest-refcount-perl/current/t/02one.t Wed May 6 02:41:09 2009
@@ -1,0 +1,29 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder::Tester tests => 3;
+
+use Test::Refcount;
+
+my $anon = [];
+
+test_out( "ok 1 - anon ARRAY ref" );
+is_oneref( $anon, 'anon ARRAY ref' );
+test_test( "anon ARRAY ref succeeds" );
+
+my $object = bless {}, "Some::Class";
+
+test_out( "ok 1 - object" );
+is_oneref( $object, 'object' );
+test_test( "normal object succeeds" );
+
+my $newref = $object;
+
+test_out( "not ok 1 - one ref" );
+test_fail( +4 );
+test_err( "# expected 1 references, found 2" );
+test_err( qr/^# Some::Class=HASH\(0x[0-9a-f]+\) (?:\[refcount 2\] )?is\n/ );
+test_err( qr/(?:^#.*\n){1,}/m ); # Don't be sensitive on what Devel::FindRef actually prints
+is_oneref( $object, 'one ref' );
+test_test( "two refs to object fails to be 1" );
Added: branches/upstream/libtest-refcount-perl/current/t/03weak.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/t/03weak.t?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/t/03weak.t (added)
+++ branches/upstream/libtest-refcount-perl/current/t/03weak.t Wed May 6 02:41:09 2009
@@ -1,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder::Tester tests => 2;
+
+use Scalar::Util qw( weaken );
+
+use Test::Refcount;
+
+my $object = bless {}, "Some::Class";
+
+my $newref = $object;
+
+test_out( "not ok 1 - one ref" );
+test_fail( +4 );
+test_err( "# expected 1 references, found 2" );
+test_err( qr/^# Some::Class=HASH\(0x[0-9a-f]+\) (?:\[refcount 2\] )?is\n/ );
+test_err( qr/(?:^#.*\n){1,}/m ); # Don't be sensitive on what Devel::FindRef actually prints
+is_oneref( $object, 'one ref' );
+test_test( "two refs to object fails to be 1" );
+
+weaken( $newref );
+
+test_out( "ok 1 - object with weakref" );
+is_oneref( $object, 'object with weakref' );
+test_test( "object with weakref succeeds" );
Added: branches/upstream/libtest-refcount-perl/current/t/04reftypes.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-refcount-perl/current/t/04reftypes.t?rev=34829&op=file
==============================================================================
--- branches/upstream/libtest-refcount-perl/current/t/04reftypes.t (added)
+++ branches/upstream/libtest-refcount-perl/current/t/04reftypes.t Wed May 6 02:41:09 2009
@@ -1,0 +1,37 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder::Tester tests => 6;
+use Test::More;
+
+use Symbol qw( gensym );
+
+use Test::Refcount;
+
+my %refs = (
+ SCALAR => do { my $var; \$var },
+ ARRAY => [],
+ HASH => +{},
+ # This magic is to ensure the code ref is new, not shared. To be a new one
+ # it has to contain a unique pad.
+ CODE => do { my $var; sub { $var } },
+ GLOB => gensym(),
+ Regex => qr/foo/,
+);
+
+foreach my $type (qw( SCALAR ARRAY HASH CODE GLOB Regex )) {
+ SKIP: {
+ if( $type eq "Regex" and $] >= 5.011 ) {
+ # Perl v5.11 seems to have odd behaviour with Regexp references. They start
+ # off with a refcount of 2. Not sure if this is a bug in Perl, or my
+ # assumption. Until P5P have worked it out, we'll skip this. See also
+ # similar skip logic in Devel-Refcount's tests
+ skip "Bleadperl", 1;
+ }
+
+ test_out( "ok 1 - anon $type ref" );
+ is_refcount( $refs{$type}, 1, "anon $type ref" );
+ test_test( "anon $type ref succeeds" );
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list