| To: | bug-test-memory-cycle [...] rt.cpan.org |
| From: | Stevan Little <stevan [...] iinteractive.com> |
| Subject: | Added support for memory_cycle_exists() |
| Date: | Fri, 21 Jan 2005 13:29:03 -0500 |
Andy,
Here is the patch for adding memory_cycle_exists support to
Test::Memory::Cycle along with the new test file (cycle-exists.t I
called it). Let me know if you have any problems with it.
Thanks,
- Steve
diff -r Cycle.pm Cycle.pm
56a57
Show quoted text
> *{$caller.'::memory_cycle_exists'} = \&memory_cycle_exists;
103a105,127
Show quoted text >
> =head2 C<memory_cycle_exists( I<$object>, I<$msg> )>
>
> Checks that I<$object> B<does> have any circular memory references.
>
> =cut
>
> sub memory_cycle_exists {
> my $ref = shift;
> my $msg = shift;
>
> my $cycle_no = 0;
> my @diags;
>
> # Callback function that is called once for each memory cycle
found.
Show quoted text > my $callback = sub { $cycle_no++ };
>
> find_cycle( $ref, $callback );
> my $ok = $cycle_no;
> $Test->ok( $ok, $msg );
>
> return $ok;
> } # memory_cycle_exists
diff -r t/family-array.t t/family-array.t
5c5
< use Test::More tests => 2;
---
Show quoted text > use Test::More tests => 3;
53a54,58
Show quoted text >
> 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" );
>
diff -r t/family-hash.t t/family-hash.t
5c5
< use Test::More tests => 2;
---
Show quoted text > use Test::More tests => 3;
28a29,32
Show quoted text >
> test_out( "ok 1 - Small family has Cycles" );
> memory_cycle_exists( $me, "Small family has Cycles" );
> test_test( "Small family testing for cycles" );
diff -r t/family-object.t t/family-object.t
5c5
< use Test::More tests => 2;
---
Show quoted text > use Test::More tests => 3;
37a38,41
Show quoted text >
> test_out( "ok 1 - Object family has Cycles" );
> memory_cycle_exists( $dis, "Object family has Cycles" );
> test_test( "Object family testing with cycles" );
diff -r t/family-scalar.t t/family-scalar.t
5c5
< use Test::More tests => 5;
---
Show quoted text > use Test::More tests => 8;
21a22,25
Show quoted text > test_out( "ok 1 - Scalar Family has Cycles" );
> memory_cycle_exists( $me, "Scalar Family has Cycles" );
> test_test( "Simple loopback testing for cycles" );
>
32a37,40
Show quoted text > test_out( "ok 1" );
> memory_cycle_exists( $myself ); # Test non-comments
> test_test( "Simple loopback to myself with cycles" );
>
58a67,70
Show quoted text >
> test_out( "ok 1" );
> memory_cycle_exists( $sybil ); # Test non-comments
> test_test( "Sybil and her sisters have cycles" );
# (cycle-exists.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" );
}