From: Dave Rolsky <autarch@urth.org>
Date: Fri, 9 Jul 2004 17:06:07 +0000 (-0500)
Subject: Bug with NEXT when called from an eval block
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=874ad44d852a3d0f27f985a25ac70c3cde24a259;hp=078c425b721ea35d568a7ec980e3b95d036a25c3;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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)