Change 20591 by [EMAIL PROTECTED] on 2003/08/09 21:08:59
Subject: [PATCH] add "$lexical not available" warning in C<for my $lex ()>
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: Sat, 9 Aug 2003 14:51:44 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#100 edit
... //depot/perl/embed.h#413 edit
... //depot/perl/global.sym#243 edit
... //depot/perl/op.c#580 edit
... //depot/perl/pp_ctl.c#365 edit
... //depot/perl/proto.h#452 edit
... //depot/perl/scope.c#113 edit
... //depot/perl/scope.h#61 edit
... //depot/perl/t/lib/warnings/pad#5 edit
Differences ...
==== //depot/perl/embed.fnc#100 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#99~20170~ Fri Jul 18 01:03:02 2003
+++ perl/embed.fnc Sat Aug 9 14:08:59 2003
@@ -1391,6 +1391,7 @@
#if defined(DEBUGGING)
p |int |get_debug_opts |char **s
#endif
+Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val
==== //depot/perl/embed.h#413 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#412~20170~ Fri Jul 18 01:03:02 2003
+++ perl/embed.h Sat Aug 9 14:08:59 2003
@@ -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)
==== //depot/perl/global.sym#243 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#242~20116~ Thu Jul 10 10:28:00 2003
+++ perl/global.sym Sat Aug 9 14:08:59 2003
@@ -660,3 +660,4 @@
Perl_PerlIO_stdin
Perl_PerlIO_stdout
Perl_PerlIO_stderr
+Perl_save_set_svflags
==== //depot/perl/op.c#580 (text) ====
Index: perl/op.c
--- perl/op.c#579~20171~ Sun Jul 20 13:12:54 2003
+++ perl/op.c Sat Aug 9 14:08:59 2003
@@ -3751,7 +3751,7 @@
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
{
==== //depot/perl/pp_ctl.c#365 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#364~20177~ Mon Jul 21 12:14:35 2003
+++ perl/pp_ctl.c Sat Aug 9 14:08:59 2003
@@ -1731,6 +1731,11 @@
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);
==== //depot/perl/proto.h#452 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#451~20170~ Fri Jul 18 01:03:02 2003
+++ perl/proto.h Sat Aug 9 14:08:59 2003
@@ -1331,6 +1331,7 @@
#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);
==== //depot/perl/scope.c#113 (text) ====
Index: perl/scope.c
--- perl/scope.c#112~20559~ Thu Aug 7 12:59:18 2003
+++ perl/scope.c Sat Aug 9 14:08:59 2003
@@ -281,6 +281,18 @@
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)
{
@@ -1034,6 +1046,15 @@
ptr = SSPOPPTR;
if (ptr)
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:
==== //depot/perl/scope.h#61 (text) ====
Index: perl/scope.h
--- perl/scope.h#60~19934~ Wed Jul 2 12:39:11 2003
+++ perl/scope.h Sat Aug 9 14:08:59 2003
@@ -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 @@
#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) \
==== //depot/perl/t/lib/warnings/pad#5 (text) ====
Index: perl/t/lib/warnings/pad
--- perl/t/lib/warnings/pad#4~20559~ Thu Aug 7 12:59:18 2003
+++ perl/t/lib/warnings/pad Sat Aug 9 14:08:59 2003
@@ -159,6 +159,15 @@
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 {
End of Patch.
