diff options
-rw-r--r-- | cop.h | 10 | ||||
-rw-r--r-- | cv.h | 9 | ||||
-rw-r--r-- | op.c | 4 | ||||
-rw-r--r-- | perly.c | 4 | ||||
-rw-r--r-- | perly.y | 4 | ||||
-rw-r--r-- | pp_ctl.c | 2 | ||||
-rwxr-xr-x | t/op/misc.t | 14 | ||||
-rw-r--r-- | vms/perly_c.vms | 4 |
8 files changed, 37 insertions, 14 deletions
@@ -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, \ @@ -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)) @@ -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; @@ -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" @@ -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); } ; @@ -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 2d19ee1b4b..48e22f6405 100755 --- 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 d2782f102c..17023a0140 100644 --- 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" |