Change 18223 by [EMAIL PROTECTED] on 2002/12/02 02:46:17
Subject: [PATCH] SvFAKE lexicals in scope for all of the sub
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: Mon, 25 Nov 2002 21:25:33 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/Devel/Peek/Peek.t#20 edit
.... //depot/perl/pad.c#6 edit
.... //depot/perl/t/op/closure.t#16 edit
Differences ...
==== //depot/perl/ext/Devel/Peek/Peek.t#20 (text) ====
Index: perl/ext/Devel/Peek/Peek.t
--- perl/ext/Devel/Peek/Peek.t#19~18220~ Sun Dec 1 16:58:54 2002
+++ perl/ext/Devel/Peek/Peek.t Sun Dec 1 18:46:17 2002
@@ -251,9 +251,9 @@
OUTSIDE_SEQ = \\d+
PADLIST = $ADDR
PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
- \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
- \\d+\\. $ADDR<\\d+> FAKE \\(\\d+,\\d+\\) "\\$DEBUG"
- \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
+ \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
+ \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG"
+ \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
OUTSIDE = $ADDR \\(MAIN\\)');
do_test(15,
==== //depot/perl/pad.c#6 (text) ====
Index: perl/pad.c
--- perl/pad.c#5~18220~ Sun Dec 1 16:58:54 2002
+++ perl/pad.c Sun Dec 1 18:46:17 2002
@@ -74,7 +74,9 @@
store the generation number during compilation.
If SvFAKE is set on the name SV then slot in the frame AVs are
-a REFCNT'ed references to a lexical from "outside".
+a REFCNT'ed references to a lexical from "outside". In this case,
+the name SV does not have a cop_seq range, since it is in scope
+throughout.
If the 'name' is '&' the the corresponding entry in frame AV
is a CV representing a possible closure.
@@ -298,24 +300,13 @@
{
PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
SV* namesv = NEWSV(1102, 0);
- U32 min, max;
ASSERT_CURPAD_ACTIVE("pad_add_name");
- if (fake) {
- min = PL_curcop->cop_seq;
- max = PAD_MAX;
- }
- else {
- /* not yet introduced */
- min = PAD_MAX;
- max = 0;
- }
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad addname: %ld \"%s\", (%lu,%lu)%s\n",
- (long)offset, name, (unsigned long)min, (unsigned long)max,
- (fake ? " FAKE" : "")
+ "Pad addname: %ld \"%s\"%s\n",
+ (long)offset, name, (fake ? " FAKE" : "")
)
);
@@ -332,11 +323,13 @@
}
av_store(PL_comppad_name, offset, namesv);
- SvNVX(namesv) = (NV)min;
- SvIVX(namesv) = max;
if (fake)
SvFAKE_on(namesv);
else {
+ /* not yet introduced */
+ SvNVX(namesv) = (NV)PAD_MAX; /* min */
+ SvIVX(namesv) = 0; /* max */
+
if (!PL_min_intro_pending)
PL_min_intro_pending = offset;
PL_max_intro_pending = offset;
@@ -478,6 +471,7 @@
for (off = top; (I32)off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &PL_sv_undef
+ && !SvFAKE(sv)
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& (!is_our
|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
@@ -497,6 +491,7 @@
do {
if ((sv = svp[off])
&& sv != &PL_sv_undef
+ && !SvFAKE(sv)
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
&& strEQ(name, SvPVX(sv)))
@@ -529,7 +524,7 @@
Perl_pad_findmy(pTHX_ char *name)
{
I32 off;
- I32 pendoff = 0;
+ I32 fake_off = 0;
SV *sv;
SV **svp = AvARRAY(PL_comppad_name);
U32 seq = PL_cop_seqmax;
@@ -539,27 +534,33 @@
/* The one we're looking for is probably just before comppad_name_fill. */
for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
- if ((sv = svp[off]) &&
- sv != &PL_sv_undef &&
- (!SvIVX(sv) ||
- (seq <= (U32)SvIVX(sv) &&
- seq > (U32)I_32(SvNVX(sv)))) &&
- strEQ(SvPVX(sv), name))
- {
- if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
- return (PADOFFSET)off;
- pendoff = off; /* this pending def. will override import */
+ sv = svp[off];
+ if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
+ continue;
+ if (SvFAKE(sv)) {
+ /* we'll use this later if we don't find a real entry */
+ fake_off = off;
+ continue;
+ }
+ else {
+ if (
+ ( seq > (U32)I_32(SvNVX(sv)) /* min */
+ && seq <= (U32)SvIVX(sv)) /* max */
+ ||
+ /* 'our' is visible before introduction */
+ (!SvIVX(sv) && (SvFLAGS(sv) & SVpad_OUR))
+ )
+ return off;
}
}
+ if (fake_off)
+ return fake_off;
/* See if it's in a nested scope */
off = pad_findlex(name, 0, PL_compcv);
if (!off) /* pad_findlex returns 0 for failure...*/
return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
- /* If there is a pending local definition, this new alias must die */
- if (pendoff)
- SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
return off;
}
@@ -581,10 +582,14 @@
S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv)
{
CV *cv;
- I32 off;
+ I32 off = 0;
SV *sv;
CV* startcv;
U32 seq;
+ I32 depth;
+ AV *oldpad;
+ SV *oldsv;
+ AV *curlist;
ASSERT_CURPAD_ACTIVE("pad_findlex");
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -596,135 +601,156 @@
startcv = CvOUTSIDE(innercv);
for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
- AV *curlist = CvPADLIST(cv);
- SV **svp = av_fetch(curlist, 0, FALSE);
+ SV **svp;
AV *curname;
+ I32 fake_off = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
" searching: cv=0x%"UVxf" seq=%d\n",
PTR2UV(cv), (int) seq )
);
+ curlist = CvPADLIST(cv);
+ svp = av_fetch(curlist, 0, FALSE);
if (!svp || *svp == &PL_sv_undef)
continue;
curname = (AV*)*svp;
svp = AvARRAY(curname);
+
+ depth = CvDEPTH(cv);
for (off = AvFILLp(curname); off > 0; off--) {
- I32 depth;
- AV *oldpad;
- SV *oldsv;
-
- if ( ! (
- (sv = svp[off]) &&
- sv != &PL_sv_undef &&
- seq <= (U32)SvIVX(sv) &&
- seq > (U32)I_32(SvNVX(sv)) &&
- strEQ(SvPVX(sv), name))
- )
+ sv = svp[off];
+ if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX(sv), name))
continue;
-
- depth = CvDEPTH(cv);
- if (!depth) {
- if (newoff) {
- if (SvFAKE(sv))
- continue;
- return 0; /* don't clone from inactive stack frame */
- }
- depth = 1;
+ if (SvFAKE(sv)) {
+ /* we'll use this later if we don't find a real entry */
+ fake_off = off;
+ continue;
+ }
+ else {
+ if ( seq > (U32)I_32(SvNVX(sv)) /* min */
+ && seq <= (U32)SvIVX(sv) /* max */
+ && !(newoff && !depth) /* ignore inactive when cloning */
+ )
+ goto found;
}
+ }
+
+ /* no real entry - but did we find a fake one? */
+ if (fake_off) {
+ if (newoff && !depth)
+ return 0; /* don't clone from inactive stack frame */
+ off = fake_off;
+ sv = svp[off];
+ goto found;
+ }
+ }
+ return 0;
- oldpad = (AV*)AvARRAY(curlist)[depth];
- oldsv = *av_fetch(oldpad, off, TRUE);
+found:
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- " matched: offset %ld"
- " %s(%lu,%lu), sv=0x%"UVxf"\n",
- (long)off,
- SvFAKE(sv) ? "FAKE " : "",
- (unsigned long)I_32(SvNVX(sv)),
- (unsigned long)SvIVX(sv),
- PTR2UV(oldsv)
- )
- );
+ if (!depth)
+ depth = 1;
- if (!newoff) { /* Not a mere clone operation. */
- newoff = pad_add_name(
- SvPVX(sv),
- (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
- (SvFLAGS(sv) & SVpad_OUR) ? GvSTASH(sv) : Nullhv,
- 1 /* fake */
- );
+ oldpad = (AV*)AvARRAY(curlist)[depth];
+ oldsv = *av_fetch(oldpad, off, TRUE);
- if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
- /* "It's closures all the way down." */
- CvCLONE_on(PL_compcv);
- if (cv == startcv) {
- if (CvANON(PL_compcv))
- oldsv = Nullsv; /* no need to keep ref */
+#ifdef DEBUGGING
+ if (SvFAKE(sv))
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ " matched: offset %ld"
+ " FAKE, sv=0x%"UVxf"\n",
+ (long)off,
+ PTR2UV(oldsv)
+ )
+ );
+ else
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ " matched: offset %ld"
+ " (%lu,%lu), sv=0x%"UVxf"\n",
+ (long)off,
+ (unsigned long)I_32(SvNVX(sv)),
+ (unsigned long)SvIVX(sv),
+ PTR2UV(oldsv)
+ )
+ );
+#endif
+
+ if (!newoff) { /* Not a mere clone operation. */
+ newoff = pad_add_name(
+ SvPVX(sv),
+ (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
+ (SvFLAGS(sv) & SVpad_OUR) ? GvSTASH(sv) : Nullhv,
+ 1 /* fake */
+ );
+
+ if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
+ /* "It's closures all the way down." */
+ CvCLONE_on(PL_compcv);
+ if (cv == startcv) {
+ if (CvANON(PL_compcv))
+ oldsv = Nullsv; /* no need to keep ref */
+ }
+ else {
+ CV *bcv;
+ for (bcv = startcv;
+ bcv && bcv != cv && !CvCLONE(bcv);
+ bcv = CvOUTSIDE(bcv))
+ {
+ if (CvANON(bcv)) {
+ /* install the missing pad entry in intervening
+ * nested subs and mark them cloneable. */
+ AV *ocomppad_name = PL_comppad_name;
+ PAD *ocomppad = PL_comppad;
+ AV *padlist = CvPADLIST(bcv);
+ PL_comppad_name = (AV*)AvARRAY(padlist)[0];
+ PL_comppad = (AV*)AvARRAY(padlist)[1];
+ PL_curpad = AvARRAY(PL_comppad);
+ pad_add_name(
+ SvPVX(sv),
+ (SvFLAGS(sv) & SVpad_TYPED)
+ ? SvSTASH(sv) : Nullhv,
+ (SvFLAGS(sv) & SVpad_OUR)
+ ? GvSTASH(sv) : Nullhv,
+ 1 /* fake */
+ );
+
+ PL_comppad_name = ocomppad_name;
+ PL_comppad = ocomppad;
+ PL_curpad = ocomppad ?
+ AvARRAY(ocomppad) : Null(SV **);
+ CvCLONE_on(bcv);
}
else {
- CV *bcv;
- for (bcv = startcv;
- bcv && bcv != cv && !CvCLONE(bcv);
- bcv = CvOUTSIDE(bcv))
+ if (ckWARN(WARN_CLOSURE)
+ && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
{
- if (CvANON(bcv)) {
- /* install the missing pad entry in intervening
- * nested subs and mark them cloneable. */
- AV *ocomppad_name = PL_comppad_name;
- PAD *ocomppad = PL_comppad;
- AV *padlist = CvPADLIST(bcv);
- PL_comppad_name = (AV*)AvARRAY(padlist)[0];
- PL_comppad = (AV*)AvARRAY(padlist)[1];
- PL_curpad = AvARRAY(PL_comppad);
- pad_add_name(
- SvPVX(sv),
- (SvFLAGS(sv) & SVpad_TYPED)
- ? SvSTASH(sv) : Nullhv,
- (SvFLAGS(sv) & SVpad_OUR)
- ? GvSTASH(sv) : Nullhv,
- 1 /* fake */
- );
-
- PL_comppad_name = ocomppad_name;
- PL_comppad = ocomppad;
- PL_curpad = ocomppad ?
- AvARRAY(ocomppad) : Null(SV **);
- CvCLONE_on(bcv);
- }
- else {
- if (ckWARN(WARN_CLOSURE)
- && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
- {
- Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" may be unavailable",
- name);
- }
- break;
- }
+ Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" may be unavailable",
+ name);
}
- }
- }
- else if (!CvUNIQUE(PL_compcv)) {
- if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
- && !(SvFLAGS(sv) & SVpad_OUR))
- {
- Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" will not stay shared", name);
+ break;
}
}
}
- av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
- ASSERT_CURPAD_ACTIVE("pad_findlex 2");
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
- (long)newoff, PTR2UV(oldsv)
- )
- );
- return newoff;
+ }
+ else if (!CvUNIQUE(PL_compcv)) {
+ if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
+ && !(SvFLAGS(sv) & SVpad_OUR))
+ {
+ Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" will not stay shared", name);
+ }
}
}
- return 0;
+ av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
+ ASSERT_CURPAD_ACTIVE("pad_findlex 2");
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
+ (long)newoff, PTR2UV(oldsv)
+ )
+ );
+ return newoff;
}
@@ -833,7 +859,9 @@
svp = AvARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
- if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
+ if ((sv = svp[i]) && sv != &PL_sv_undef
+ && !SvFAKE(sv) && !SvIVX(sv))
+ {
SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
SvNVX(sv) = (NV)PL_cop_seqmax;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -872,14 +900,17 @@
ASSERT_CURPAD_ACTIVE("pad_leavemy");
if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
- if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
+ if ((sv = svp[off]) && sv != &PL_sv_undef
+ && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"%s never introduced", SvPVX(sv));
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
- if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX) {
+ if ((sv = svp[off]) && sv != &PL_sv_undef
+ && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
+ {
SvIVX(sv) = PL_cop_seqmax;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
@@ -1127,16 +1158,24 @@
namesv = Nullsv;
}
if (namesv) {
- Perl_dump_indent(aTHX_ level+1, file,
- "%2d. 0x%"UVxf"<%lu> %s (%lu,%lu) \"%s\"\n",
- (int) ix,
- PTR2UV(ppad[ix]),
- (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
- SvFAKE(namesv) ? "FAKE" : " ",
- (unsigned long)I_32(SvNVX(namesv)),
- (unsigned long)SvIVX(namesv),
- SvPVX(namesv)
- );
+ if (SvFAKE(namesv))
+ Perl_dump_indent(aTHX_ level+1, file,
+ "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
+ (int) ix,
+ PTR2UV(ppad[ix]),
+ (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
+ SvPVX(namesv)
+ );
+ else
+ Perl_dump_indent(aTHX_ level+1, file,
+ "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
+ (int) ix,
+ PTR2UV(ppad[ix]),
+ (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
+ (unsigned long)I_32(SvNVX(namesv)),
+ (unsigned long)SvIVX(namesv),
+ SvPVX(namesv)
+ );
}
else if (full) {
Perl_dump_indent(aTHX_ level+1, file,
==== //depot/perl/t/op/closure.t#16 (xtext) ====
Index: perl/t/op/closure.t
--- perl/t/op/closure.t#15~18118~ Thu Nov 7 03:33:38 2002
+++ perl/t/op/closure.t Sun Dec 1 18:46:17 2002
@@ -13,7 +13,7 @@
use Config;
-print "1..174\n";
+print "1..177\n";
my $test = 1;
sub test (&) {
@@ -534,3 +534,18 @@
$x =~ s/o//eg;
test { $x eq 'fbar' }
}
+
+# DAPM 24-Nov-02
+# SvFAKE lexicals should be visible thoughout a function.
+# On <= 5.8.0, the third test failed, eg bugid #18286
+
+{
+ my $x = 1;
+ sub fake {
+ test { sub {eval'$x'}->() == 1 };
+ { $x; test { sub {eval'$x'}->() == 1 } }
+ test { sub {eval'$x'}->() == 1 };
+ }
+}
+fake();
+
End of Patch.
