Bug with NEXT when called from an eval block

Message-ID: <Pine.LNX.4.58.0407091703010.4578@urth.org>

p4raw-id: //depot/perl@23075

diff --git a/lib/NEXT.pm b/lib/NEXT.pm
index 64610fe..1c6a316 100644 (file)
--- a/lib/NEXT.pm
+++ b/lib/NEXT.pm
@@ -1,5 +1,5 @@
 package NEXT;
-$VERSION = '0.60';
+$VERSION = '0.60_01';
 use Carp;
 use strict;
 
@@ -32,7 +32,9 @@ sub NEXT::ELSEWHERE::ordered_ancestors
 sub AUTOLOAD
 {
        my ($self) = @_;
-       my $caller = (caller(1))[3]; 
+       my $depth = 1;
+       until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ }
+       my $caller = (caller($depth))[3];
        my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD';
        undef $NEXT::AUTOLOAD;
        my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
@@ -94,7 +96,9 @@ package EVERY;                        @ISA = 'NEXT';
 sub AUTOLOAD
 {
        my ($self) = @_;
-       my $caller = (caller(1))[3]; 
+       my $depth = 1;
+       until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ }
+       my $caller = (caller($depth))[3];
        my $wanted = $EVERY::AUTOLOAD || 'EVERY::AUTOLOAD';
        undef $EVERY::AUTOLOAD;
        my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;

diff --git a/lib/NEXT/t/next.t b/lib/NEXT/t/next.t
index 8cc493f..8b26f0e 100644 (file)
--- a/lib/NEXT/t/next.t
+++ b/lib/NEXT/t/next.t
@@ -5,7 +5,7 @@ BEGIN {
     }
 }
 
-BEGIN { print "1..25\n"; }
+BEGIN { print "1..26\n"; }
 
 use NEXT;
 
@@ -14,6 +14,7 @@ print "ok 1\n";
 package A;
 sub A::method   { return ( 3, $_[0]->NEXT::method() ) }
 sub A::DESTROY  { $_[0]->NEXT::DESTROY() }
+sub A::evaled   { eval { $_[0]->NEXT::evaled(); return 'evaled' } }
 
 package B;
 use base qw( A );
@@ -22,13 +23,13 @@ sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() )
 sub B::DESTROY  { $_[0]->NEXT::DESTROY() }
 
 package C;
-sub C::DESTROY  { print "ok 23\n"; $_[0]->NEXT::DESTROY() }
+sub C::DESTROY  { print "ok 24\n"; $_[0]->NEXT::DESTROY() }
 
 package D;
 @D::ISA = qw( B C E );
 sub D::method   { return ( 2, $_[0]->NEXT::method() ) }
 sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
-sub D::DESTROY  { print "ok 22\n"; $_[0]->NEXT::DESTROY() }
+sub D::DESTROY  { print "ok 23\n"; $_[0]->NEXT::DESTROY() }
 sub D::oops     { $_[0]->NEXT::method() }
 sub D::secondary { return ( 17, 18, map { $_+10 } $_[0]->NEXT::secondary() ) }
 
@@ -37,17 +38,17 @@ package E;
 sub E::method   { return ( 4,  $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
 sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) 
                        if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
-sub E::DESTROY  { print "ok 24\n"; $_[0]->NEXT::DESTROY() }
+sub E::DESTROY  { print "ok 25\n"; $_[0]->NEXT::DESTROY() }
 
 package F;
 sub F::method   { return ( 5  ) }
 sub F::AUTOLOAD { return ( 11 ) if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
-sub F::DESTROY  { print "ok 25\n" }
+sub F::DESTROY  { print "ok 26\n" }
 
 package G;
 sub G::method   { return ( 6 ) }
 sub G::AUTOLOAD { print "not "; return }
-sub G::DESTROY  { print "not ok 21"; return }
+sub G::DESTROY  { print "not ok 22"; return }
 
 package main;
 
@@ -103,4 +104,11 @@ print "ok 16\n";
 @vals = $obj->secondary();
 print map "ok $_\n", @vals;
 
-# CAN REDISPATCH DESTRUCTORS (ok 22..25)
+# TEST HANDLING OF NEXT:: INSIDE EVAL (22)
+eval {
+       $obj->evaled;
+       $@ && print "not ";
+};
+print "ok 22\n";
+
+# CAN REDISPATCH DESTRUCTORS (ok 23..26)