view release on metacpan or  search on metacpan

t/Devel-Cycle.t  view on Meta::CPAN

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 };