Integrate change #10448 from maintperl; lexicals

outside an eval"" weren't resolved correctly inside a subroutine
definition inside the eval"" if they were not already referenced
in the toplevel of the eval""-ed code

p4raw-link: @10448 on //depot/maint-5.6/perl: 332ba4f98bc63c81fd7ba0d06432a7f903d716cf

p4raw-id: //depot/perl@10449
p4raw-integrated: from //depot/maint-5.6/perl@10447 'merge in' cop.h
	(@9288..) t/op/misc.t (@10394..) op.c pp_ctl.c (@10412..)

diff --git a/cop.h b/cop.h
index 6c6820b..8d8126b 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -156,6 +156,7 @@ struct block_eval {
     SV *       old_namesv;
     OP *       old_eval_root;
     SV *       cur_text;
+    CV *       cv;
 };
 
 #define PUSHEVAL(cx,n,fgv)                                             \
@@ -165,6 +166,7 @@ struct block_eval {
        cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv);          \
        cx->blk_eval.old_eval_root = PL_eval_root;                      \
        cx->blk_eval.cur_text = PL_linestr;                             \
+       cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */  \
     } STMT_END
 
 #define POPEVAL(cx)                                                    \

diff --git a/op.c b/op.c
index 34fb48a..1874518 100644 (file)
--- a/op.c
+++ b/op.c
@@ -346,15 +346,22 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
        switch (CxTYPE(cx)) {
        default:
            if (i == 0 && saweval) {
-               seq = cxstack[saweval].blk_oldcop->cop_seq;
                return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
            }
            break;
        case CXt_EVAL:
            switch (cx->blk_eval.old_op_type) {
            case OP_ENTEREVAL:
-               if (CxREALEVAL(cx))
+               if (CxREALEVAL(cx)) {
+                   PADOFFSET off;
                    saweval = i;
+                   seq = cxstack[i].blk_oldcop->cop_seq;
+                   startcv = cxstack[i].blk_eval.cv;
+                   off = pad_findlex(name, newoff, seq, startcv, i-1,
+                                     saweval, 0);
+                   if (off)    /* continue looking if not found here */
+                       return off;
+               }
                break;
            case OP_DOFILE:
            case OP_REQUIRE:
@@ -371,7 +378,6 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                saweval = i;    /* so we know where we were called from */
                continue;
            }
-           seq = cxstack[saweval].blk_oldcop->cop_seq;
            return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
        }
     }

diff --git a/pp_ctl.c b/pp_ctl.c
index a161372..046c666 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2832,6 +2832,9 @@ S_doeval(pTHX_ int gimme, OP** startop)
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
     CvEVAL_on(PL_compcv);
+    assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+    cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
+
 #ifdef USE_THREADS
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);

diff --git a/t/op/misc.t b/t/op/misc.t
index 8e67b61..881f99d 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -587,6 +587,18 @@ EXPECT
 ok 1
 ok 2
 ########
+# lexicals outside an eval"" should be visible inside subroutine definitions
+# within it
+eval <<'EOT'; die $@ if $@;
+{
+    my $X = "ok\n";
+    eval 'sub Y { print $X }'; die $@ if $@;
+    Y();
+}
+EOT
+EXPECT
+ok
+########
 # This test is here instead of pragma/locale.t because
 # the bug depends on in the internal state of the locale
 # settings and pragma/locale messes up that state pretty badly.