diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 5 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | scope.c | 21 | ||||
| -rw-r--r-- | scope.h | 2 | ||||
| -rw-r--r-- | t/lib/warnings/pad | 9 |
9 files changed, 43 insertions, 1 deletions
@@ -1391,6 +1391,7 @@ p |void |free_tied_hv_pool #if defined(DEBUGGING) p |int |get_debug_opts |char **s #endif +Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val @@ -2148,6 +2148,7 @@ #define get_debug_opts Perl_get_debug_opts #endif #endif +#define save_set_svflags Perl_save_set_svflags #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -4632,6 +4633,7 @@ #define get_debug_opts(a) Perl_get_debug_opts(aTHX_ a) #endif #endif +#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c) #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/global.sym b/global.sym index 2f47926bf0..8d0e0da275 100644 --- a/global.sym +++ b/global.sym @@ -660,3 +660,4 @@ Perl_PerlIO_get_cnt Perl_PerlIO_stdin Perl_PerlIO_stdout Perl_PerlIO_stderr +Perl_save_set_svflags @@ -3751,7 +3751,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo append_elem(OP_LIST, expr, scalar(sv)))); assert(!loop->op_next); /* for my $x () sets OPpLVAL_INTRO; - * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */ + * for our $x () sets OPpOUR_INTRO */ loop->op_private = (U8)iterpflags; #ifdef PL_OP_SLAB_ALLOC { @@ -1731,6 +1731,11 @@ PP(pp_enteriter) SAVETMPS; if (PL_op->op_targ) { + if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */ + SvPADSTALE_off(PAD_SVl(PL_op->op_targ)); + SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ), + SVs_PADSTALE, SVs_PADSTALE); + } #ifndef USE_ITHREADS svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */ SAVESPTR(*svp); @@ -1331,6 +1331,7 @@ PERL_CALLCONV void Perl_free_tied_hv_pool(pTHX); #if defined(DEBUGGING) PERL_CALLCONV int Perl_get_debug_opts(pTHX_ char **s); #endif +PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val); @@ -281,6 +281,18 @@ Perl_save_shared_pvref(pTHX_ char **str) SSPUSHINT(SAVEt_SHARED_PVREF); } +/* set the SvFLAGS specified by mask to the values in val */ + +void +Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val) +{ + SSCHECK(4); + SSPUSHPTR(sv); + SSPUSHINT(mask); + SSPUSHINT(val); + SSPUSHINT(SAVEt_SET_SVFLAGS); +} + void Perl_save_gp(pTHX_ GV *gv, I32 empty) { @@ -1036,6 +1048,15 @@ Perl_leave_scope(pTHX_ I32 base) AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR; } break; + case SAVEt_SET_SVFLAGS: + { + U32 val = (U32)SSPOPINT; + U32 mask = (U32)SSPOPINT; + sv = (SV*)SSPOPPTR; + SvFLAGS(sv) &= ~mask; + SvFLAGS(sv) |= val; + } + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } @@ -47,6 +47,7 @@ #define SAVEt_MORTALIZESV 36 #define SAVEt_SHARED_PVREF 37 #define SAVEt_BOOL 38 +#define SAVEt_SET_SVFLAGS 39 #ifndef SCOPE_SAVES_SIGNAL_MASK #define SCOPE_SAVES_SIGNAL_MASK 0 @@ -132,6 +133,7 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>. #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) #define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) #define SAVESHAREDPV(s) save_shared_pvref((char**)&(s)) +#define SAVESETSVFLAGS(sv,mask,val) save_set_svflags(sv,mask,val) #define SAVEDELETE(h,k,l) \ save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) #define SAVEDESTRUCTOR(f,p) \ diff --git a/t/lib/warnings/pad b/t/lib/warnings/pad index 441fba29bd..568e2f4a05 100644 --- a/t/lib/warnings/pad +++ b/t/lib/warnings/pad @@ -159,6 +159,15 @@ f2(); EXPECT Variable "$x" is not available at (eval 1) line 2. ######## +use warnings 'closure' ; +for my $x (1,2,3) { + sub f { eval '$x' } + f(); +} +f(); +EXPECT +Variable "$x" is not available at (eval 4) line 2. +######## # pad.c no warnings 'closure' ; sub x { |