r17491 - in /branches/upstream/libdevel-cycle-perl: ./ current/ current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/README current/lib/ current/lib/Devel/ current/lib/Devel/Cycle.pm current/t/ current/t/Devel-Cycle.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sun Mar 16 00:42:16 UTC 2008
Author: gregoa-guest
Date: Sun Mar 16 00:42:15 2008
New Revision: 17491
URL: http://svn.debian.org/wsvn/?sc=1&rev=17491
Log:
[svn-inject] Installing original source of libdevel-cycle-perl
Added:
branches/upstream/libdevel-cycle-perl/
branches/upstream/libdevel-cycle-perl/current/
branches/upstream/libdevel-cycle-perl/current/Changes
branches/upstream/libdevel-cycle-perl/current/MANIFEST
branches/upstream/libdevel-cycle-perl/current/META.yml
branches/upstream/libdevel-cycle-perl/current/Makefile.PL
branches/upstream/libdevel-cycle-perl/current/README
branches/upstream/libdevel-cycle-perl/current/lib/
branches/upstream/libdevel-cycle-perl/current/lib/Devel/
branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm
branches/upstream/libdevel-cycle-perl/current/t/
branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t
Added: branches/upstream/libdevel-cycle-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/Changes?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/Changes (added)
+++ branches/upstream/libdevel-cycle-perl/current/Changes Sun Mar 16 00:42:15 2008
@@ -1,0 +1,32 @@
+Revision history for Perl extension Devel::Cycle.
+
+1.07 Tue May 23 22:28:03 EDT 2006
+ - Fixed export_to_level() problem so that Test::Memory::Cycle works again.
+
+1.06 Tue May 23 17:08:22 EDT 2006
+ - Removed debugging warning.
+ - Only checks CODErefs if PadWalker version >= 1.0.
+
+1.05 May 18 2006
+ - Added ability to detect cycles in CODErefs courtesy Yuval Kogman.
+
+1.04
+ - Added ability to detect weakened cycles courtesy Stevan Little
+
+1.03 Fri Jan 21 13:47:50 EST 2005
+ - Sort the hash keys so that the cycle path is more deterministic
+ (avoids test failures in Test::Memory::Cycle)
+
+1.02 Mon Jan 12 09:04:58 EST 2004
+ - Formats anonymous memory references by default as \%A, \@B, etc,
+ rather than using hex form.
+ - Options to control memory reference formatting.
+
+1.01 Sun Dec 14 16:57:58 EST 2003
+ - Added code to skip weak refs created with Scalar::Util's
+ weaken(). (Sam Tregar)
+ - Improved formatting in output.
+
+1.00 Sat Dec 13 11:04:57 2003
+ - original version
+
Added: branches/upstream/libdevel-cycle-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/MANIFEST?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/MANIFEST (added)
+++ branches/upstream/libdevel-cycle-perl/current/MANIFEST Sun Mar 16 00:42:15 2008
@@ -1,0 +1,7 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/Devel-Cycle.t
+lib/Devel/Cycle.pm
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libdevel-cycle-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/META.yml?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/META.yml (added)
+++ branches/upstream/libdevel-cycle-perl/current/META.yml Sun Mar 16 00:42:15 2008
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Devel-Cycle
+version: 1.07
+version_from: lib/Devel/Cycle.pm
+installdirs: site
+requires:
+ Scalar::Util: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libdevel-cycle-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/Makefile.PL?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/Makefile.PL (added)
+++ branches/upstream/libdevel-cycle-perl/current/Makefile.PL Sun Mar 16 00:42:15 2008
@@ -1,0 +1,17 @@
+use 5.006001;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'Devel::Cycle',
+ VERSION_FROM => 'lib/Devel/Cycle.pm', # finds $VERSION
+ PREREQ_PM => {'Scalar::Util' => 0}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/Devel/Cycle.pm', # retrieve abstract from module
+ AUTHOR => 'Lincoln Stein <lstein at cshl.edu>') : ()),
+ LIBS => [''], # e.g., '-lm'
+ DEFINE => '', # e.g., '-DHAVE_SOMETHING'
+ INC => '-I.', # e.g., '-I. -I/usr/include/other'
+ # Un-comment this if you add C files to link with later:
+ # OBJECT => '$(O_FILES)', # link all the C files too
+);
Added: branches/upstream/libdevel-cycle-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/README?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/README (added)
+++ branches/upstream/libdevel-cycle-perl/current/README Sun Mar 16 00:42:15 2008
@@ -1,0 +1,66 @@
+Devel-Cycle version 1.00
+========================
+
+This module can be used to find memory cycles in objects and other
+references. Here is the synopsis:
+
+ #!/usr/bin/perl
+ use Devel::Cycle;
+
+ # create an object that has four cycles
+ my $test = {fred => [qw(a b c d e)],
+ ethel => [qw(1 2 3 4 5)],
+ george => {martha => 23,
+ agnes => 19}
+ };
+ # cycle 1
+ $test->{george}{phyllis} = $test;
+ # cycle 2
+ $test->{fred}[3] = $test->{george};
+ # cycles 3 and 4
+ $test->{george}{mary} = $test->{fred};
+ find_cycle($test);
+ exit 0;
+
+ # output of the script:
+
+ Cycle (1):
+ HASH(0x8171d30)->{george} => HASH(0x8171d00)
+ HASH(0x8171d00)->{phyllis} => HASH(0x8171d30)
+
+ Cycle (2):
+ HASH(0x8171d30)->{george} => HASH(0x8171d00)
+ HASH(0x8171d00)->{mary} => ARRAY(0x814be60)
+ ARRAY(0x814be60)->[3] => HASH(0x8171d00)
+
+ Cycle (3):
+ HASH(0x8171d30)->{fred} => ARRAY(0x814be60)
+ ARRAY(0x814be60)->[3] => HASH(0x8171d00)
+ HASH(0x8171d00)->{phyllis} => HASH(0x8171d30)
+
+ Cycle (4):
+ HASH(0x8171d30)->{fred} => ARRAY(0x814be60)
+ ARRAY(0x814be60)->[3] => HASH(0x8171d00)
+ HASH(0x8171d00)->{mary} => ARRAY(0x814be60)
+
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2003 by Lincoln Stein
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Added: branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm (added)
+++ branches/upstream/libdevel-cycle-perl/current/lib/Devel/Cycle.pm Sun Mar 16 00:42:15 2008
@@ -1,0 +1,404 @@
+package Devel::Cycle;
+# $Id: Cycle.pm,v 1.10 2006/05/24 02:29:32 lstein Exp $
+
+use 5.006001;
+use strict;
+use Carp 'croak','carp';
+use warnings;
+
+use Scalar::Util qw(isweak blessed);
+
+my $SHORT_NAME = 'A';
+my %SHORT_NAMES;
+
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(find_cycle find_weakened_cycle);
+our @EXPORT_OK = qw($FORMATTING);
+our $VERSION = '1.07';
+our $FORMATTING = 'roasted';
+our $QUIET = 0;
+
+my %import_args = (-quiet =>1,
+ -raw =>1,
+ -cooked =>1,
+ -roasted=>1);
+
+BEGIN {
+ require constant;
+ constant->import( HAVE_PADWALKER =>
+ eval {
+ require PadWalker;
+ $PadWalker::VERSION >= 1.0;
+ });
+}
+
+sub import {
+ my $self = shift;
+ my @args = @_;
+ my %args = map {$_=>1} @args;
+ $QUIET++ if exists $args{-quiet};
+ $FORMATTING = 'roasted' if exists $args{-roasted};
+ $FORMATTING = 'raw' if exists $args{-raw};
+ $FORMATTING = 'cooked' if exists $args{-cooked};
+ $self->export_to_level(1,$self,grep {!exists $import_args{$_}} @_);
+}
+
+sub find_weakened_cycle {
+ my $ref = shift;
+ my $callback = shift;
+ unless ($callback) {
+ my $counter = 0;
+ $callback = sub {
+ _do_report(++$counter,shift)
+ }
+ }
+ _find_cycle($ref,{},$callback,1,());
+}
+
+sub find_cycle {
+ my $ref = shift;
+ my $callback = shift;
+ unless ($callback) {
+ my $counter = 0;
+ $callback = sub {
+ _do_report(++$counter,shift)
+ }
+ }
+ _find_cycle($ref,{},$callback,0,());
+}
+
+sub _find_cycle {
+ my $current = shift;
+ my $seenit = shift;
+ my $callback = shift;
+ my $inc_weak_refs = shift;
+ my %complain;
+ my @report = @_;
+
+ return unless ref $current;
+
+ # note: it seems like you could just do:
+ #
+ # return if isweak($current);
+ #
+ # but strangely the weak flag doesn't seem to survive the copying,
+ # so the test has to happen directly on the reference in the data
+ # structure being scanned.
+
+ if ($seenit->{$current}) {
+ $callback->(\@report);
+ return;
+ }
+ $seenit->{$current}++;
+
+ my $type = _get_type($current);
+
+ if ($type eq 'SCALAR') {
+ return if !$inc_weak_refs && isweak($current);
+ _find_cycle($$current,{%$seenit},$callback,$inc_weak_refs,
+ (@report,['SCALAR',undef,$current => $$current,$inc_weak_refs?isweak($current):()]));
+ }
+
+ elsif ($type eq 'ARRAY') {
+ for (my $i=0; $i<@$current; $i++) {
+ next if !$inc_weak_refs && isweak($current->[$i]);
+ _find_cycle($current->[$i],{%$seenit},$callback,$inc_weak_refs,
+ (@report,['ARRAY',$i,$current => $current->[$i],$inc_weak_refs?isweak($current->[$i]):()]));
+ }
+ }
+ elsif ($type eq 'HASH') {
+ for my $key (sort keys %$current) {
+ next if !$inc_weak_refs && isweak($current->{$key});
+ _find_cycle($current->{$key},{%$seenit},$callback,$inc_weak_refs,
+ (@report,['HASH',$key,$current => $current->{$key},$inc_weak_refs?isweak($current->{$key}):()]));
+ }
+ }
+ elsif ($type eq 'CODE') {
+ if (HAVE_PADWALKER) {
+ my $closed_vars = PadWalker::closed_over( $current );
+ foreach my $varname ( sort keys %$closed_vars ) {
+ my $value = $closed_vars->{$varname};
+ next if !$inc_weak_refs && isweak($$value);
+ _find_cycle( $$value,{%$seenit},$callback,$inc_weak_refs,
+ (@report,['CODE',$varname,$current => $$value,$inc_weak_refs?isweak($$value):()]));
+ }
+ } elsif (!$complain{$current}++ && !$QUIET) {
+ carp "A code closure was detected in but we cannot check it unless the PadWalker module is installed";
+ }
+ }
+}
+
+sub _do_report {
+ my $counter = shift;
+ my $path = shift;
+ print "Cycle ($counter):\n";
+ foreach (@$path) {
+ my ($type,$index,$ref,$value,$is_weak) = @$_;
+ printf("\t%30s => %-30s\n",($is_weak ? 'w-> ' : '')._format_reference($type,$index,$ref,0),_format_reference(undef,undef,$value,1));
+ }
+ print "\n";
+}
+
+sub _format_reference {
+ my ($type,$index,$ref,$deref) = @_;
+ $type ||= _get_type($ref);
+ return $ref unless $type;
+ my $suffix = defined $index ? _format_index($type,$index) : '';
+ if ($FORMATTING eq 'raw') {
+ return $ref.$suffix;
+ }
+
+ else {
+ my $package = blessed($ref);
+ my $prefix = $package ? ($FORMATTING eq 'roasted' ? "${package}::" : "${package}=" ) : '';
+ my $sygil = $deref ? '\\' : '';
+ my $shortname = ($SHORT_NAMES{$ref} ||= $SHORT_NAME++);
+ return $sygil . ($sygil ? '$' : '$$'). $prefix . $shortname . $suffix if $type eq 'SCALAR';
+ return $sygil . ($sygil ? '@' : '$') . $prefix . $shortname . $suffix if $type eq 'ARRAY';
+ return $sygil . ($sygil ? '%' : '$') . $prefix . $shortname . $suffix if $type eq 'HASH';
+ return $sygil . ($sygil ? '&' : '$') . $prefix . $shortname . $suffix if $type eq 'CODE';
+ }
+}
+
+# why not Scalar::Util::reftype?
+sub _get_type {
+ my $thingy = shift;
+ return unless ref $thingy;
+ return 'SCALAR' if UNIVERSAL::isa($thingy,'SCALAR') || UNIVERSAL::isa($thingy,'REF');
+ return 'ARRAY' if UNIVERSAL::isa($thingy,'ARRAY');
+ return 'HASH' if UNIVERSAL::isa($thingy,'HASH');
+ return 'CODE' if UNIVERSAL::isa($thingy,'CODE');
+}
+
+sub _format_index {
+ my ($type,$index) = @_;
+ return "->[$index]" if $type eq 'ARRAY';
+ return "->{'$index'}" if $type eq 'HASH';
+ return " variable $index" if $type eq 'CODE';
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Devel::Cycle - Find memory cycles in objects
+
+=head1 SYNOPSIS
+
+ #!/usr/bin/perl
+ use 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};
+ find_cycle($test);
+ exit 0;
+
+ # output:
+
+ Cycle (1):
+ $A->{'george'} => \%B
+ $B->{'phyllis'} => \%A
+
+ Cycle (2):
+ $A->{'george'} => \%B
+ $B->{'mary'} => \@A
+ $A->[3] => \%B
+
+ Cycle (3):
+ $A->{'fred'} => \@A
+ $A->[3] => \%B
+ $B->{'phyllis'} => \%A
+
+ Cycle (4):
+ $A->{'fred'} => \@A
+ $A->[3] => \%B
+ $B->{'mary'} => \@A
+
+ # you can also check weakened references
+ weaken($test->{george}->{phyllis});
+ find_weakened_cycle($test);
+ exit 0;
+
+ # output:
+
+ Cycle (1):
+ $A->{'george'} => \%B
+ $B->{'mary'} => \@C
+ $C->[3] => \%B
+
+ Cycle (2):
+ $A->{'george'} => \%B
+ w-> $B->{'phyllis'} => \%A
+
+ Cycle (3):
+ $A->{'fred'} => \@C
+ $C->[3] => \%B
+ $B->{'mary'} => \@C
+
+ Cycle (4):
+ $A->{'fred'} => \@C
+ $C->[3] => \%B
+ w-> $B->{'phyllis'} => \%A
+
+=head1 DESCRIPTION
+
+This is a simple developer's tool for finding circular references in
+objects and other types of references. Because of Perl's
+reference-count based memory management, circular references will
+cause memory leaks.
+
+=head2 EXPORT
+
+The find_cycle() and find_weakened_cycle() subroutine are exported by default.
+
+=over 4
+
+=item find_cycle($object_reference,[$callback])
+
+The find_cycle() function will traverse the object reference and print
+a report to STDOUT identifying any memory cycles it finds.
+
+If an optional callback code reference is provided, then this callback
+will be invoked on each cycle that is found. The callback will be
+passed an array reference pointing to a list of lists with the
+following format:
+
+ $arg = [ ['REFTYPE',$index,$reference,$reference_value],
+ ['REFTYPE',$index,$reference,$reference_value],
+ ['REFTYPE',$index,$reference,$reference_value],
+ ...
+ ]
+
+Each element in the array reference describes one edge in the memory
+cycle. 'REFTYPE' describes the type of the reference and is one of
+'SCALAR','ARRAY' or 'HASH'. $index is the index affected by the
+reference, and is undef for a scalar, an integer for an array
+reference, or a hash key for a hash. $reference is the memory
+reference, and $reference_value is its dereferenced value. For
+example, if the edge is an ARRAY, then the following relationship
+holds:
+
+ $reference->[$index] eq $reference_value
+
+The first element of the array reference is the $object_reference that
+you pased to find_cycle() and may not be directly involved in the
+cycle.
+
+If a reference is a weak ref produced using Scalar::Util's weaken()
+function then it won't contribute to cycles.
+
+=item find_weakened_cycle($object_reference,[$callback])
+
+The find_weakened_cycle() function will traverse the object reference and print
+a report to STDOUT identifying any memory cycles it finds, I<including> any weakened
+cycles produced using Scalar::Util's weaken().
+
+If an optional callback code reference is provided, then this callback
+will be invoked on each cycle that is found. The callback will be
+passed an array reference pointing to a list of lists with the
+following format:
+
+ $arg = [ ['REFTYPE',$index,$reference,$reference_value,$is_weakened],
+ ['REFTYPE',$index,$reference,$reference_value,$is_weakened],
+ ['REFTYPE',$index,$reference,$reference_value,$is_weakened],
+ ...
+ ]
+
+Each element in the array reference describes one edge in the memory
+cycle. 'REFTYPE' describes the type of the reference and is one of
+'SCALAR','ARRAY' or 'HASH'. $index is the index affected by the
+reference, and is undef for a scalar, an integer for an array
+reference, or a hash key for a hash. $reference is the memory
+reference, and $reference_value is its dereferenced value. $is_weakened
+is a boolean specifying if the reference is weakened or not. For
+example, if the edge is an ARRAY, then the following relationship
+holds:
+
+ $reference->[$index] eq $reference_value
+
+The first element of the array reference is the $object_reference that
+you pased to find_cycle() and may not be directly involved in the
+cycle.
+
+=back
+
+=head2 Cycle Report Formats
+
+The default callback prints out a trace of each cycle it finds. You
+can control the format of the trace by setting the package variable
+$Devel::Cycle::FORMATTING to one of "raw," "cooked," or "roasted".
+
+The "raw" format prints out anonymous memory references using standard
+Perl memory location nomenclature. For example, a "Foo::Bar" object
+that points to an ordinary hash will appear in the trace like this:
+
+ Foo::Bar=HASH(0x8124394)->{'phyllis'} => HASH(0x81b4a90)
+
+The "cooked" format (the default), uses short names for anonymous
+memory locations, beginning with "A" and moving upward with the magic
+++ operator. This leads to a much more readable display:
+
+ $Foo::Bar=B->{'phyllis'} => \%A
+
+The "roasted" format is similar to the "cooked" format, except that
+object references are formatted slightly differently:
+
+ $Foo::Bar::B->{'phyllis'} => \%A
+
+If a reference is a weakened ref, then it will have a 'w->' prepended to
+it, like this:
+
+ w-> $Foo::Bar::B->{'phyllis'} => \%A
+
+For your convenience, $Devel::Cycle::FORMATTING can be imported:
+
+ use Devel::Cycle qw(:DEFAULT $FORMATTING);
+ $FORMATTING = 'raw';
+
+Alternatively, you can control the formatting at compile time by
+passing one of the options -raw, -cooked, or -roasted to "use" as
+illustrated here:
+
+ use Devel::Cycle -raw;
+
+=head2 Code references (closures)
+
+If the PadWalker module is installed, Devel::Cycle will also report
+cycles in code closures. If PadWalker is not installed and
+Devel::Cycle detects a CODE reference in one of the data structures,
+it will warn (once per data structure) that it cannot inspect the CODE
+unless PadWalker is available. You can turn this warning off by
+passing -quiet to Devel::Cycle at compile time:
+
+ use Devel::Cycle -quiet;
+
+=head1 SEE ALSO
+
+L<Test::Memory::Cycle>
+L<Devel::Leak>
+L<Scalar::Util>
+
+=head1 AUTHOR
+
+Lincoln Stein, E<lt>lstein at cshl.eduE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2003 by Lincoln Stein
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Added: branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t?rev=17491&op=file
==============================================================================
--- branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t (added)
+++ branches/upstream/libdevel-cycle-perl/current/t/Devel-Cycle.t Sun Mar 16 00:42:15 2008
@@ -1,0 +1,59 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Devel-Cycle.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 7;
+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()');
+
More information about the Pkg-perl-cvs-commits
mailing list