distinguish eval'' from BEGIN|INIT|END CVs (fixes buggy propagation

of lexical searches in BEGIN|INIT|END)

p4raw-id: //depot/perl@2975

diff --git a/cop.h b/cop.h
index 6bdb594..aa5b6d5 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -181,17 +181,17 @@ struct block {
        cx->cx_type             = t,                                    \
        cx->blk_oldsp           = sp - PL_stack_base,                   \
        cx->blk_oldcop          = PL_curcop,                            \
-       cx->blk_oldmarksp       = PL_markstack_ptr - PL_markstack,              \
+       cx->blk_oldmarksp       = PL_markstack_ptr - PL_markstack,      \
        cx->blk_oldscopesp      = PL_scopestack_ix,                     \
-       cx->blk_oldretsp        = PL_retstack_ix,                               \
+       cx->blk_oldretsp        = PL_retstack_ix,                       \
        cx->blk_oldpm           = PL_curpm,                             \
        cx->blk_gimme           = gimme;                                \
        DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n",        \
-                   (long)cxstack_ix, PL_block_type[t]); )
+                   (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
 
 /* Exit a block (RETURN and LAST). */
 #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],                   \
-       newsp            = PL_stack_base + cx->blk_oldsp,                       \
+       newsp            = PL_stack_base + cx->blk_oldsp,               \
        PL_curcop        = cx->blk_oldcop,                              \
        PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
        PL_scopestack_ix = cx->blk_oldscopesp,                          \
@@ -203,7 +203,7 @@ struct block {
 
 /* Continue a block elsewhere (NEXT and REDO). */
 #define TOPBLOCK(cx) cx  = &cxstack[cxstack_ix],                       \
-       PL_stack_sp      = PL_stack_base + cx->blk_oldsp,                       \
+       PL_stack_sp      = PL_stack_base + cx->blk_oldsp,               \
        PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
        PL_scopestack_ix = cx->blk_oldscopesp,                          \
        PL_retstack_ix   = cx->blk_oldretsp,                            \

diff --git a/cv.h b/cv.h
index c7c7a73..0d31a44 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -94,3 +94,12 @@ struct xpvcv {
 #define CvLOCKED(cv)           (CvFLAGS(cv) & CVf_LOCKED)
 #define CvLOCKED_on(cv)                (CvFLAGS(cv) |= CVf_LOCKED)
 #define CvLOCKED_off(cv)       (CvFLAGS(cv) &= ~CVf_LOCKED)
+
+#define CvEVAL(cv)             (CvUNIQUE(cv) && !SvFAKE(cv))
+#define CvEVAL_on(cv)          (CvUNIQUE_on(cv),SvFAKE_off(cv))
+#define CvEVAL_off(cv)         CvUNIQUE_off(cv)
+
+/* BEGIN|INIT|END */
+#define CvSPECIAL(cv)          (CvUNIQUE(cv) && SvFAKE(cv))
+#define CvSPECIAL_on(cv)       (CvUNIQUE_on(cv),SvFAKE_on(cv))
+#define CvSPECIAL_off(cv)      (CvUNIQUE_off(cv),SvFAKE_off(cv))

diff --git a/op.c b/op.c
index 51df803..ec3e27b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -358,8 +358,8 @@ pad_findmy(char *name)
     /* Check if if we're compiling an eval'', and adjust seq to be the
      * eval's seq number.  This depends on eval'' having a non-null
      * CvOUTSIDE() while it is being compiled.  The eval'' itself is
-     * identified by CvUNIQUE being set and CvGV being null. */
-    if (outside && CvUNIQUE(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+     * identified by CvEVAL being true and CvGV being null. */
+    if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
        cx = &cxstack[cxstack_ix];
        if (CxREALEVAL(cx))
            seq = cx->blk_oldcop->cop_seq;

diff --git a/perly.c b/perly.c
index 739c347..938a574 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -1801,7 +1801,7 @@ case 57:
 { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
-                             CvUNIQUE_on(PL_compcv);
+                             CvSPECIAL_on(PL_compcv);
                          yyval.opval = yyvsp[0].opval; }
 break;
 case 58:
@@ -1826,7 +1826,7 @@ case 63:
 break;
 case 64:
 #line 330 "perly.y"
-{ CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
+{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 break;
 case 65:
 #line 332 "perly.y"

diff --git a/perly.y b/perly.y
index bef7d9a..565439b 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -307,7 +307,7 @@ startformsub:       /* NULL */      /* start a format subroutine scope */
 subname        :       WORD    { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
-                             CvUNIQUE_on(PL_compcv);
+                             CvSPECIAL_on(PL_compcv);
                          $$ = $1; }
        ;
 
@@ -327,7 +327,7 @@ package :   PACKAGE WORD ';'
        ;
 
 use    :       USE startsub
-                       { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
+                       { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
                    WORD WORD listexpr ';'
                        { utilize($1, $2, $4, $5, $6); }
        ;

diff --git a/pp_ctl.c b/pp_ctl.c
index 52fcf96..df2a962 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2619,7 +2619,7 @@ doeval(int gimme, OP** startop)
     SAVESPTR(PL_compcv);
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
-    CvUNIQUE_on(PL_compcv);
+    CvEVAL_on(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 2d19ee1..48e22f6 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -483,3 +483,17 @@ sub re {
     $re;
 }
 EXPECT
+########
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+EXPECT
+ZZZ
+########
+eval '
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+';
+EXPECT
+ZZZ

diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index d2782f1..17023a0 100644 (file)
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1805,7 +1805,7 @@ case 57:
 { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
-                             CvUNIQUE_on(PL_compcv);
+                             CvSPECIAL_on(PL_compcv);
                          yyval.opval = yyvsp[0].opval; }
 break;
 case 58:
@@ -1830,7 +1830,7 @@ case 63:
 break;
 case 64:
 #line 330 "perly.y"
-{ CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
+{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 break;
 case 65:
 #line 332 "perly.y"