From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 28 Feb 1999 21:12:22 +0000 (+0000)
Subject: fix longstanding bug: searches for lexicals originating within eval''
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2680586ee66b8de4d2b5f26a2013220f2bec9d5f;p=p5sagit%2Fp5-mst-13.2.git

fix longstanding bug: searches for lexicals originating within eval''
weren't stopping at the subroutine boundary correctly

p4raw-id: //depot/perl@3037
---

diff --git a/op.c b/op.c
index 279fae8..d0f139b 100644
--- a/op.c
+++ b/op.c
@@ -48,7 +48,7 @@ static OP *too_few_arguments _((OP *o, char* name));
 static OP *too_many_arguments _((OP *o, char* name));
 static void null _((OP* o));
 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
-	CV* startcv, I32 cx_ix, I32 saweval));
+	CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
 static OP *newDEFSVOP _((void));
 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
 static void simplify_sort _((OP *o));
@@ -176,8 +176,11 @@ pad_allocmy(char *name)
     return off;
 }
 
+#define FINDLEX_NOSEARCH	1		/* don't search outer contexts */
+
 STATIC PADOFFSET
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval)
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval,
+	    U32 flags)
 {
     dTHR;
     CV *cv;
@@ -272,6 +275,9 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 	}
     }
 
+    if (flags & FINDLEX_NOSEARCH)
+	return 0;
+
     /* Nothing in current lexical context--try eval's context, if any.
      * This is necessary to let the perldb get at lexically scoped variables.
      * XXX This will also probably interact badly with eval tree caching.
@@ -283,7 +289,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 	default:
 	    if (i == 0 && saweval) {
 		seq = cxstack[saweval].blk_oldcop->cop_seq;
-		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval);
+		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
 	    }
 	    break;
 	case CXt_EVAL:
@@ -306,7 +312,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 		continue;
 	    }
 	    seq = cxstack[saweval].blk_oldcop->cop_seq;
-	    return pad_findlex(name, newoff, seq, cv, i-1, saweval);
+	    return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
 	}
     }
 
@@ -366,7 +372,7 @@ pad_findmy(char *name)
     }
 
     /* See if it's in a nested scope */
-    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0);
+    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
     if (off) {
 	/* If there is a pending local definition, this new alias must die */
 	if (pendoff)
@@ -3666,7 +3672,7 @@ cv_clone2(CV *proto, CV *outside)
 	    char *name = SvPVX(namesv);    /* XXX */
 	    if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
 		I32 off = pad_findlex(name, ix, SvIVX(namesv),
-				      CvOUTSIDE(cv), cxstack_ix, 0);
+				      CvOUTSIDE(cv), cxstack_ix, 0, 0);
 		if (!off)
 		    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
 		else if (off != ix)
diff --git a/proto.h b/proto.h
index d2898fe..e2ea784 100644
--- a/proto.h
+++ b/proto.h
@@ -814,7 +814,7 @@ OP *scalarboolean _((OP *o));
 OP *too_few_arguments _((OP *o, char* name));
 OP *too_many_arguments _((OP *o, char* name));
 void null _((OP* o));
-PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval));
+PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
 OP *newDEFSVOP _((void));
 char* gv_ename _((GV *gv));
 CV *cv_clone2 _((CV *proto, CV *outside));
diff --git a/t/op/eval.t b/t/op/eval.t
index 498c63a..5822797 100755
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..29\n";
+print "1..30\n";
 
 eval 'print "ok 1\n";';
 
@@ -129,3 +129,14 @@ eval <<'EOT';
   }
 EOT
 create_closure("ok $x\n")->();
+$x++;
+
+# does lexical search terminate correctly at subroutine boundary?
+$main::r = "ok $x\n";
+sub terminal { eval 'print $r' }
+{
+   my $r = "not ok $x\n";
+   eval 'terminal($r)';
+}
+$x++;
+