I am an idiot
Stevan Little [Fri, 30 Dec 2005 02:18:15 +0000 (02:18 +0000)]
ChangeLog
MANIFEST
lib/Class/C3.pm
t/35_next_method_in_anon.t [new file with mode: 0644]

index 5b4f28c..35620ed 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -7,8 +7,8 @@ Revision history for Perl extension Class::C3.
     - tweaked &_merge to avoid un-needed looping. Thanks to 
       Audrey Tang for this fix.
     - added better support for calling next::method within 
-      an eval BLOCK. Thanks to Justin Guenther for this patch
-      and test.
+      an eval BLOCKs and anon-subroutines. Thanks to Justin 
+      Guenther for this patch and test.
 
 0.07 - Wed, Nov 23, 2005
     * all bugs found by, and fixes provided by Matt S. Trout *
index ea660ca..d5bb3d0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -20,6 +20,7 @@ t/31_next_method_skip.t
 t/32_next_method_edge_cases.t
 t/33_next_method_used_with_NEXT.t
 t/34_next_method_in_eval.t
+t/35_next_method_in_anon.t
 t/pod.t
 t/pod_coverage.t
 t/lib/A.pm
index 6a23d4d..4d14e72 100644 (file)
@@ -213,12 +213,14 @@ our %METHOD_CACHE;
 
 sub method {
     my $level = 1;
-    my $method_caller;
+    my ($method_caller, $label, @label);
     while ($method_caller = (caller($level++))[3]) {
-        last unless $method_caller eq '(eval)';
+      @label = (split '::', $method_caller);
+      $label = pop @label;
+      last unless
+        $label eq '(eval)' ||
+        $label eq '__ANON__';
     }
-    my @label    = (split '::', $method_caller);    
-    my $label    = pop @label;
     my $caller   = join '::' => @label;    
     my $self     = $_[0];
     my $class    = blessed($self) || $self;
diff --git a/t/35_next_method_in_anon.t b/t/35_next_method_in_anon.t
new file mode 100644 (file)
index 0000000..cca371e
--- /dev/null
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+    use lib 'opt', '../opt', '../blib/lib';    
+    use_ok('c3');
+}
+
+=pod
+
+This tests the successful handling of a next::method call from within an
+anonymous subroutine.
+
+=cut
+
+{
+    package A;
+    use c3; 
+
+    sub foo {
+      return 'A::foo';
+    }
+
+    sub bar {
+      return 'A::bar';
+    }
+}
+
+{
+    package B;
+    use base 'A';
+    use c3; 
+    
+    sub foo {
+      my $code = sub {
+        return 'B::foo => ' . (shift)->next::method();
+      };
+      return (shift)->$code;
+    }
+
+    sub bar {
+      my $code1 = sub {
+        my $code2 = sub {
+          return 'B::bar => ' . (shift)->next::method();
+        };
+        return (shift)->$code2;
+      };
+      return (shift)->$code1;
+    }
+}
+
+is(B->foo, "B::foo => A::foo",
+   'method resolved inside anonymous sub');
+
+is(B->bar, "B::bar => A::bar",
+   'method resolved inside nested anonymous subs');
+
+