From 1aff0e911b5282f0638dc0d8199ffa4edf98f89c Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Thu, 18 Feb 1999 21:41:57 +0000 Subject: [PATCH] distinguish eval'' from BEGIN|INIT|END CVs (fixes buggy propagation of lexical searches in BEGIN|INIT|END) p4raw-id: //depot/perl@2975 --- cop.h | 10 +++++----- cv.h | 9 +++++++++ op.c | 4 ++-- perly.c | 4 ++-- perly.y | 4 ++-- pp_ctl.c | 2 +- t/op/misc.t | 14 ++++++++++++++ vms/perly_c.vms | 4 ++-- 8 files changed, 37 insertions(+), 14 deletions(-) diff --git a/cop.h b/cop.h index 6bdb594..aa5b6d5 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.8.3.1