more inf loop tests, inf loop bugfix, better error message

diff --git a/lib/Algorithm/C3.pm b/lib/Algorithm/C3.pm
index 7e96573..92ae309 100644 (file)
--- a/lib/Algorithm/C3.pm
+++ b/lib/Algorithm/C3.pm
@@ -24,16 +24,21 @@ sub merge {
     my $current_parents = [ $root->$parent_fetcher ];
     my $recurse_mergeout = [];
     my $i = 0;
-    my %seen;
+    my %seen = ( $root => 1 );
 
     while(1) {
         if($i < @$current_parents) {
             my $new_root = $current_parents->[$i++];
 
             if($seen{$new_root}) {
-                # XXX Can we give them a better diagnostic, with a list from $root => $new_root => foo => $new_root ??
-                die "Infinite loop detected, $new_root appears"
-                  . " twice in a bad way in the parents of $root"
+                my @isastack = (
+                    (map { $_->[0] } @STACK),
+                    $current_root,
+                    $new_root
+                );
+                shift @isastack while $isastack[0] ne $new_root;
+                my $isastack = join(q{ -> }, @isastack);
+                die "Infinite loop detected in parents of '$root': $isastack";
             }
             $seen{$new_root} = 1;
 

diff --git a/t/011_infinite_loop.t b/t/011_infinite_loop.t
index b291015..7195d64 100644 (file)
--- a/t/011_infinite_loop.t
+++ b/t/011_infinite_loop.t
@@ -7,7 +7,7 @@ use Test::More;
 use Algorithm::C3; # we already did use_ok 10 times by now..
 
 plan skip_all => "Your system has no SIGALRM" if !exists $SIG{ALRM};
-plan tests => 5;
+plan tests => 8;
 
 =pod
 
@@ -84,6 +84,45 @@ my @loopies = (
         b => [],
         a => [],
     },
+    { #6
+        k => [qw(j i)],
+        j => [qw(f)],
+        i => [qw(h f)],
+        h => [qw(g)],
+        g => [qw(d)],
+        f => [qw(e)],
+        e => [qw(d)],
+        d => [qw(a b c)],
+        c => [],
+        b => [qw(b)],
+        a => [],
+    },
+    { #7
+        k => [qw(k j i)],
+        j => [qw(f)],
+        i => [qw(h f)],
+        h => [qw(g)],
+        g => [qw(d)],
+        f => [qw(e)],
+        e => [qw(d)],
+        d => [qw(a b c)],
+        c => [],
+        b => [],
+        a => [],
+    },
+    { #7
+        k => [qw(j i)],
+        j => [qw(f)],
+        i => [qw(h f)],
+        h => [qw(g)],
+        g => [qw(d)],
+        f => [qw(e)],
+        e => [qw(d)],
+        d => [qw(a h b c)],
+        c => [],
+        b => [],
+        a => [],
+    },
 );
 
 foreach my $loopy (@loopies) {