summaryrefslogtreecommitdiff
path: root/pad.c
diff options
context:
space:
mode:
authorDave Mitchell <davem@fdisolutions.com>2003-05-31 20:54:48 +0100
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2003-05-31 18:33:07 +0000
commit71f882da828ecd892a162839f27e4625d69023fb (patch)
treeaec07a1ff1cac538c9b9c2426fbb4b427a03e341 /pad.c
parent0aeb64d0d71d7345dba69c9999c49f4fbb55b24b (diff)
downloadperl-71f882da828ecd892a162839f27e4625d69023fb.tar.gz
jumbo closure patch broke formats
Message-ID: <20030531185448.GA6055@fdgroup.com> Plus restore the original test script for bug #22372 p4raw-id: //depot/perl@19649
Diffstat (limited to 'pad.c')
-rw-r--r--pad.c58
1 files changed, 41 insertions, 17 deletions
diff --git a/pad.c b/pad.c
index 8e78c736ac..e8296a3412 100644
--- a/pad.c
+++ b/pad.c
@@ -88,6 +88,9 @@ is a CV representing a possible closure.
(SvFAKE and name of '&' is not a meaningful combination currently but could
become so if C<my sub foo {}> is implemented.)
+Note that formats are treated as anon subs, and are cloned each time
+write is called (if necessary).
+
=cut
*/
@@ -572,6 +575,9 @@ the parent pad.
* all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
#define CvCOMPILED(cv) CvROOT(cv)
+/* the CV does late binding of its lexicals */
+#define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
+
STATIC PADOFFSET
S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
@@ -720,9 +726,9 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
return NOT_IN_PAD;
/* out_capture non-null means caller wants us to capture lex; in
- * addition we capture ourselves unless its an ANON */
+ * addition we capture ourselves unless it's an ANON/format */
new_capturep = out_capture ? out_capture :
- CvANON(cv) ? Null(SV**) : &new_capture;
+ CvLATE(cv) ? Null(SV**) : &new_capture;
offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
new_capturep, out_name_sv, out_flags);
@@ -760,7 +766,7 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
if (SvFLAGS(new_namesv) & SVpad_OUR) {
/* do nothing */
}
- else if (CvANON(cv)) {
+ else if (CvLATE(cv)) {
/* delayed creation - just note the offset within parent pad */
SvNVX(new_namesv) = (NV)offset;
CvCLONE_on(cv);
@@ -1267,6 +1273,7 @@ S_cv_dump(pTHX_ CV *cv, char *title)
title,
PTR2UV(cv),
(CvANON(cv) ? "ANON"
+ : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
: (cv == PL_main_cv) ? "MAIN"
: CvUNIQUE(cv) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
@@ -1312,13 +1319,21 @@ Perl_cv_clone(pTHX_ CV *proto)
CV* cv;
SV** outpad;
CV* outside;
+ long depth;
assert(!CvUNIQUE(proto));
- outside = find_runcv(NULL);
- /* presumably whoever invoked us must be active */
- assert(outside);
- assert(CvDEPTH(outside));
+ /* Since cloneable anon subs can be nested, CvOUTSIDE may point
+ * to a prototype; we instead want the cloned parent who called us.
+ * Note that in general for formats, CvOUTSIDE != find_runcv */
+
+ outside = CvOUTSIDE(proto);
+ if (outside && CvCLONE(outside) && ! CvCLONED(outside))
+ outside = find_runcv(NULL);
+ depth = CvDEPTH(outside);
+ assert(depth || SvTYPE(proto) == SVt_PVFM);
+ if (!depth)
+ depth = 1;
assert(CvPADLIST(outside));
ENTER;
@@ -1353,18 +1368,28 @@ Perl_cv_clone(pTHX_ CV *proto)
PL_curpad = AvARRAY(PL_comppad);
- outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[CvDEPTH(outside)]);
+ outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
for (ix = fpad; ix > 0; ix--) {
SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
- SV *sv;
- if (namesv && namesv != &PL_sv_undef) {
+ SV *sv = Nullsv;
+ if (namesv && namesv != &PL_sv_undef) { /* lexical */
if (SvFAKE(namesv)) { /* lexical from outside? */
- assert(outpad[(I32)SvNVX(namesv)] &&
- !SvPADSTALE(outpad[(I32)SvNVX(namesv)]));
- PL_curpad[ix] = SvREFCNT_inc(outpad[(I32)SvNVX(namesv)]);
+ sv = outpad[(I32)SvNVX(namesv)];
+ assert(sv);
+ /* formats may have an inactive parent */
+ if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
+ if (ckWARN(WARN_CLOSURE))
+ Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" is not available", SvPVX(namesv));
+ sv = Nullsv;
+ }
+ else {
+ assert(!SvPADSTALE(sv));
+ sv = SvREFCNT_inc(sv);
+ }
}
- else {
+ if (!sv) {
char *name = SvPVX(namesv);
if (*name == '&')
sv = SvREFCNT_inc(ppad[ix]);
@@ -1375,17 +1400,16 @@ Perl_cv_clone(pTHX_ CV *proto)
else
sv = NEWSV(0, 0);
SvPADMY_on(sv);
- PL_curpad[ix] = sv;
}
}
else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
- PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+ sv = SvREFCNT_inc(ppad[ix]);
}
else {
sv = NEWSV(0, 0);
SvPADTMP_on(sv);
- PL_curpad[ix] = sv;
}
+ PL_curpad[ix] = sv;
}
DEBUG_Xv(