/* pad.c
*
- * Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ * by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
+ */
+
+/*
+ * 'Anyway: there was this Mr. Frodo left an orphan and stranded, as you
+ * might say, among those queer Bucklanders, being brought up anyhow in
+ * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
+ * never had fewer than a couple of hundred relations in the place.
+ * Mr. Bilbo never did a kinder deed than when he brought the lad back
+ * to live among decent folk.' --the Gaffer
*
- * "Anyway: there was this Mr Frodo left an orphan and stranded, as you
- * might say, among those queer Bucklanders, being brought up anyhow in
- * Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
- * never had fewer than a couple of hundred relations in the place. Mr
- * Bilbo never did a kinder deed than when he brought the lad back to
- * live among decent folk." --the Gaffer
+ * [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
*/
/* XXX DAPM
xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
which the name is valid. For typed lexicals name SV is SVt_PVMG and SvSTASH
points at the type. For C<our> lexicals, the type is also SVt_PVMG, with the
-OURSTASH slot pointing at the stash of the associated global (so that
-duplicate C<our> declarations in the same package can be detected). SvCUR is
+SvOURSTASH slot pointing at the stash of the associated global (so that
+duplicate C<our> declarations in the same package can be detected). SvUVX is
sometimes hijacked to store the generation number during compilation.
If SvFAKE is set on the name SV, then that slot in the frame AV is
{ my $x = 1; sub f { eval '$x'} } f();
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
=cut
*/
#define PARENT_FAKELEX_FLAGS_set(sv,val) \
STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
-#define PAD_MAX IV_MAX
+#define PAD_MAX I32_MAX
#ifdef PERL_MAD
void pad_peg(const char* s) {
static int pegcnt;
+
+ PERL_ARGS_ASSERT_PAD_PEG;
+
pegcnt++;
}
#endif
SAVEI32(PL_comppad_name_fill);
SAVEI32(PL_min_intro_pending);
SAVEI32(PL_max_intro_pending);
- SAVEI32(PL_cv_has_eval);
+ SAVEBOOL(PL_cv_has_eval);
if (flags & padnew_SAVESUB) {
- SAVEI32(PL_pad_reset_pending);
+ SAVEBOOL(PL_pad_reset_pending);
}
}
}
AV * const a0 = newAV(); /* will be @_ */
av_extend(a0, 0);
- av_store(pad, 0, (SV*)a0);
+ av_store(pad, 0, MUTABLE_SV(a0));
AvREIFY_only(a0);
}
else {
}
AvREAL_off(padlist);
- av_store(padlist, 0, (SV*)padname);
- av_store(padlist, 1, (SV*)pad);
+ av_store(padlist, 0, MUTABLE_SV(padname));
+ av_store(padlist, 1, MUTABLE_SV(pad));
/* ... then update state variables */
- PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
- PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
+ PL_comppad_name = MUTABLE_AV((*av_fetch(padlist, 0, FALSE)));
+ PL_comppad = MUTABLE_AV((*av_fetch(padlist, 1, FALSE)));
PL_curpad = AvARRAY(PL_comppad);
if (! (flags & padnew_CLONE)) {
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_PAD_UNDEF;
+
pad_peg("pad_undef");
if (!padlist)
return;
return;
DEBUG_X(PerlIO_printf(Perl_debug_log,
- "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n",
- PTR2UV(cv), PTR2UV(padlist))
+ "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
+ PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
);
/* detach any '&' anon children in the pad; if afterwards they
if (!PL_dirty) { /* don't bother during global destruction */
CV * const outercv = CvOUTSIDE(cv);
const U32 seq = CvOUTSIDE_SEQ(cv);
- AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
SV ** const namepad = AvARRAY(comppad_name);
- AV * const comppad = (AV*)AvARRAY(padlist)[1];
+ AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
SV ** const curpad = AvARRAY(comppad);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
SV * const namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
&& *SvPVX_const(namesv) == '&')
{
- CV * const innercv = (CV*)curpad[ix];
+ CV * const innercv = MUTABLE_CV(curpad[ix]);
U32 inner_rc = SvREFCNT(innercv);
assert(inner_rc);
namepad[ix] = NULL;
ix = AvFILLp(padlist);
while (ix >= 0) {
- const SV* const sv = AvARRAY(padlist)[ix--];
+ SV* const sv = AvARRAY(padlist)[ix--];
if (sv) {
- if (sv == (SV*)PL_comppad_name)
+ if (sv == (const SV *)PL_comppad_name)
PL_comppad_name = NULL;
- else if (sv == (SV*)PL_comppad) {
+ else if (sv == (const SV *)PL_comppad) {
PL_comppad = NULL;
PL_curpad = NULL;
}
}
SvREFCNT_dec(sv);
}
- SvREFCNT_dec((SV*)CvPADLIST(cv));
+ SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
CvPADLIST(cv) = NULL;
}
If C<typestash> is valid, the name is for a typed lexical; set the
name's stash to that value.
If C<ourstash> is valid, it's an our lexical, set the name's
-OURSTASH to that value
+SvOURSTASH to that value
If fake, it means we're cloning an existing entry
*/
PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
+Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
+ HV *typestash, HV *ourstash)
{
dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
- SV* const namesv = newSV(0);
+ SV *namesv;
+
+ PERL_ARGS_ASSERT_PAD_ADD_NAME;
ASSERT_CURPAD_ACTIVE("pad_add_name");
+ if (flags & ~(pad_add_STATE|pad_add_FAKE))
+ Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+ (UV)flags);
+
+ namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+ /* Until we're using the length for real, cross check that we're being told
+ the truth. */
+ PERL_UNUSED_ARG(len);
+ assert(strlen(name) == len);
- sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
sv_setpv(namesv, name);
if (typestash) {
assert(SvTYPE(namesv) == SVt_PVMG);
SvPAD_TYPED_on(namesv);
- SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
+ SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
}
if (ourstash) {
SvPAD_OUR_on(namesv);
- OURSTASH_set(namesv, ourstash);
+ SvOURSTASH_set(namesv, ourstash);
SvREFCNT_inc_simple_void_NN(ourstash);
}
- else if (state) {
+ else if (flags & pad_add_STATE) {
SvPAD_STATE_on(namesv);
}
av_store(PL_comppad_name, offset, namesv);
- if (fake) {
+ if (flags & pad_add_FAKE) {
SvFAKE_on(namesv);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
/* XXX DAPM since slot has been allocated, replace
* av_store with PL_curpad[offset] ? */
if (*name == '@')
- av_store(PL_comppad, offset, (SV*)newAV());
+ av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
else if (*name == '%')
- av_store(PL_comppad, offset, (SV*)newHV());
+ av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
SvPADMY_on(PL_curpad[offset]);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
/* And flag whether the incoming name is UTF8 or 8 bit?
Could do this either with the +ve/-ve hack of the HV code, or expanding
the flag bits. Either way, this makes proper Unicode safe pad support.
- Also could change the sv structure to make the NV a union with 2 U32s,
- so that SvCUR() could stop being overloaded in pad SVs.
NWC
*/
{
dVAR;
PADOFFSET ix;
- SV* const name = newSV(0);
+ SV* const name = newSV_type(SVt_PVNV);
+
+ PERL_ARGS_ASSERT_PAD_ADD_ANON;
+
pad_peg("add_anon");
- sv_upgrade(name, SVt_PVNV);
- sv_setpvn(name, "&", 1);
+ sv_setpvs(name, "&");
/* Are these two actually ever read? */
COP_SEQ_RANGE_HIGH_set(name, ~0);
COP_SEQ_RANGE_LOW_set(name, 1);
/* to avoid ref loops, we never have parent + child referencing each
* other simultaneously */
- if (CvOUTSIDE((CV*)sv)) {
- assert(!CvWEAKOUTSIDE((CV*)sv));
- CvWEAKOUTSIDE_on((CV*)sv);
- SvREFCNT_dec(CvOUTSIDE((CV*)sv));
+ if (CvOUTSIDE((const CV *)sv)) {
+ assert(!CvWEAKOUTSIDE((const CV *)sv));
+ CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
+ SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));
}
return ix;
}
/* XXX DAPM integrate this into pad_add_name ??? */
void
-Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
+Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
+ const HV *ourstash)
{
dVAR;
SV **svp;
PADOFFSET top, off;
+ const U32 is_our = flags & pad_add_OUR;
+
+ PERL_ARGS_ASSERT_PAD_CHECK_DUP;
ASSERT_CURPAD_ACTIVE("pad_check_dup");
+
+ if (flags & ~pad_add_OUR)
+ Perl_croak(aTHX_ "panic: pad_check_dup illegal flag bits 0x%" UVxf,
+ (UV)flags);
+
+ /* Until we're using the length for real, cross check that we're being told
+ the truth. */
+ PERL_UNUSED_ARG(len);
+ assert(strlen(name) == len);
+
if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
if (is_our && (SvPAD_OUR(sv)))
break; /* "our" masking "our" */
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "\"%s\" variable %s masks earlier declaration in same %s",
- (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"),
- name,
+ "\"%s\" variable %"SVf" masks earlier declaration in same %s",
+ (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
+ sv,
(COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
--off;
break;
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
&& (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
- && OURSTASH(sv) == ourstash
+ && SvOURSTASH(sv) == ourstash
&& strEQ(name, SvPVX_const(sv)))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "\"our\" variable %s redeclared", name);
+ "\"our\" variable %"SVf" redeclared", sv);
if ((I32)off <= PL_comppad_name_floor)
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\t(Did you mean \"local\" instead of \"our\"?)\n");
*/
PADOFFSET
-Perl_pad_findmy(pTHX_ const char *name)
+Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
{
dVAR;
SV *out_sv;
const AV *nameav;
SV **name_svp;
+ PERL_ARGS_ASSERT_PAD_FINDMY;
+
pad_peg("pad_findmy");
+
+ if (flags)
+ Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
+ (UV)flags);
+
+ /* Yes, it is a bug (read work in progress) that we're not really using this
+ length parameter, and instead relying on strlen() later on. But I'm not
+ comfortable about changing the pad API piecemeal to use and rely on
+ lengths. This only exists to avoid an "unused parameter" warning. */
+ if (len < 2)
+ return NOT_IN_PAD;
+
+ /* But until we're using the length for real, cross check that we're being
+ told the truth. */
+ assert(strlen(name) == len);
+
offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
NULL, &out_sv, &out_flags);
if ((PADOFFSET)offset != NOT_IN_PAD)
* our $foo = 0 unless defined $foo;
* to not give a warning. (Yes, this is a hack) */
- nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
+ nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
name_svp = AvARRAY(nameav);
for (offset = AvFILLp(nameav); offset > 0; offset--) {
const SV * const namesv = name_svp[offset];
SV **new_capturep;
const AV * const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_PAD_FINDLEX;
+
*out_flags = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
if (padlist) { /* not an undef CV */
I32 fake_offset = 0;
- const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+ const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
SV * const * const name_svp = AvARRAY(nameav);
for (offset = AvFILLp(nameav); offset > 0; offset--) {
? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
: *out_flags & PAD_FAKELEX_ANON)
{
- if (warn && ckWARN(WARN_CLOSURE))
- Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", name);
+ if (warn)
+ Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" is not available", name);
*out_capture = NULL;
}
else {
int newwarn = warn;
if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
+ && !SvPAD_STATE(name_svp[offset])
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
return offset;
}
- *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
- CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
+ *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
+ CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
PTR2UV(cv), PTR2UV(*out_capture)));
- if (SvPADSTALE(*out_capture)) {
- if (ckWARN(WARN_CLOSURE))
- Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", name);
+ if (SvPADSTALE(*out_capture)
+ && !SvPAD_STATE(name_svp[offset]))
+ {
+ Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" is not available", name);
*out_capture = NULL;
}
}
if (!*out_capture) {
if (*name == '@')
- *out_capture = sv_2mortal((SV*)newAV());
+ *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
else if (*name == '%')
- *out_capture = sv_2mortal((SV*)newHV());
+ *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
else
*out_capture = sv_newmortal();
}
SV *new_namesv;
AV * const ocomppad_name = PL_comppad_name;
PAD * const ocomppad = PL_comppad;
- PL_comppad_name = (AV*)AvARRAY(padlist)[0];
- PL_comppad = (AV*)AvARRAY(padlist)[1];
+ PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+ PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
PL_curpad = AvARRAY(PL_comppad);
new_offset = pad_add_name(
SvPVX_const(*out_name_sv),
+ SvCUR(*out_name_sv),
+ /* state variable ? */
+ pad_add_FAKE | (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0),
SvPAD_TYPED(*out_name_sv)
? SvSTASH(*out_name_sv) : NULL,
- OURSTASH(*out_name_sv),
- 1, /* fake */
- 0 /* not a state variable */
+ SvOURSTASH(*out_name_sv)
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
{
dVAR;
+
+ PERL_ARGS_ASSERT_PAD_SETSV;
+
ASSERT_CURPAD_ACTIVE("pad_setsv");
DEBUG_X(PerlIO_printf(Perl_debug_log,
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--) {
const SV * const sv = svp[off];
- if (sv && sv != &PL_sv_undef
- && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "%"SVf" never introduced",
- (void*)sv);
+ if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+ "%"SVf" never introduced",
+ SVfARG(sv));
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
* to a shared TARG. Such an alias will change randomly and unpredictably.
* We avoid doing this until we can think of a Better Way.
* GSAR 97-10-29 */
-void
-Perl_pad_reset(pTHX)
+static void
+S_pad_reset(pTHX)
{
dVAR;
#ifdef USE_BROKEN_PAD_RESET
/* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
AV * const av = newAV(); /* Will be @_ */
av_extend(av, 0);
- av_store(PL_comppad, 0, (SV*)av);
+ av_store(PL_comppad, 0, MUTABLE_SV(av));
AvREIFY_only(av);
}
SvPADTMP_off(PL_curpad[po]);
#ifdef USE_ITHREADS
/* SV could be a shared hash key (eg bugid #19022) */
- if (
-#ifdef PERL_OLD_COPY_ON_WRITE
- !SvIsCOW(PL_curpad[po])
-#else
- !SvFAKE(PL_curpad[po])
-#endif
- )
+ if (!SvIsCOW(PL_curpad[po]))
SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
#endif
}
SV **ppad;
I32 ix;
+ PERL_ARGS_ASSERT_DO_DUMP_PAD;
+
if (!padlist) {
return;
}
- pad_name = (AV*)*av_fetch((AV*)padlist, 0, FALSE);
- pad = (AV*)*av_fetch((AV*)padlist, 1, FALSE);
+ pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
+ pad = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 1, FALSE));
pname = AvARRAY(pad_name);
ppad = AvARRAY(pad);
Perl_dump_indent(aTHX_ level, file,
const CV * const outside = CvOUTSIDE(cv);
AV* const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_CV_DUMP;
+
PerlIO_printf(Perl_debug_log,
" %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
title,
dVAR;
I32 ix;
AV* const protopadlist = CvPADLIST(proto);
- const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
- const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+ const AV *const protopad_name = (const AV *)*av_fetch(protopadlist, 0, FALSE);
+ const AV *const protopad = (const AV *)*av_fetch(protopadlist, 1, FALSE);
SV** const pname = AvARRAY(protopad_name);
SV** const ppad = AvARRAY(protopad);
const I32 fname = AvFILLp(protopad_name);
CV* outside;
long depth;
+ PERL_ARGS_ASSERT_CV_CLONE;
+
assert(!CvUNIQUE(proto));
/* Since cloneable anon subs can be nested, CvOUTSIDE may point
ENTER;
SAVESPTR(PL_compcv);
- cv = PL_compcv = (CV*)newSV(0);
- sv_upgrade((SV *)cv, SvTYPE(proto));
+ cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
CvCLONED_on(cv);
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
OP_REFCNT_UNLOCK;
CvSTART(cv) = CvSTART(proto);
- CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside);
+ CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
if (SvPOK(proto))
- sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
+ sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
if (SvFAKE(namesv)) { /* lexical from outside? */
sv = outpad[PARENT_PAD_INDEX(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_const(namesv));
+ /* formats may have an inactive parent,
+ while my $x if $false can leave an active var marked as
+ stale. And state vars are always available */
+ if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+ "Variable \"%s\" is not available", SvPVX_const(namesv));
sv = NULL;
}
- else {
- assert(!SvPADSTALE(sv));
+ else
SvREFCNT_inc_simple_void_NN(sv);
- }
}
if (!sv) {
const char sigil = SvPVX_const(namesv)[0];
if (sigil == '&')
sv = SvREFCNT_inc(ppad[ix]);
else if (sigil == '@')
- sv = (SV*)newAV();
+ sv = MUTABLE_SV(newAV());
else if (sigil == '%')
- sv = (SV*)newHV();
+ sv = MUTABLE_SV(newHV());
else
sv = newSV(0);
SvPADMY_on(sv);
+ /* reset the 'assign only once' flag on each state var */
+ if (SvPAD_STATE(namesv))
+ SvPADSTALE_on(sv);
}
}
else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
{
dVAR;
I32 ix;
- AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
- AV * const comppad = (AV*)AvARRAY(padlist)[1];
+ AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+ AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
SV ** const namepad = AvARRAY(comppad_name);
SV ** const curpad = AvARRAY(comppad);
+
+ PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
PERL_UNUSED_ARG(old_cv);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
if (namesv && namesv != &PL_sv_undef
&& *SvPVX_const(namesv) == '&')
{
- CV * const innercv = (CV*)curpad[ix];
+ CV * const innercv = MUTABLE_CV(curpad[ix]);
assert(CvWEAKOUTSIDE(innercv));
assert(CvOUTSIDE(innercv) == old_cv);
CvOUTSIDE(innercv) = new_cv;
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
dVAR;
+
+ PERL_ARGS_ASSERT_PAD_PUSH;
+
if (depth > AvFILLp(padlist)) {
SV** const svp = AvARRAY(padlist);
AV* const newpad = newAV();
SV** const oldpad = AvARRAY(svp[depth-1]);
- I32 ix = AvFILLp((AV*)svp[1]);
- const I32 names_fill = AvFILLp((AV*)svp[0]);
+ I32 ix = AvFILLp((const AV *)svp[1]);
+ const I32 names_fill = AvFILLp((const AV *)svp[0]);
SV** const names = AvARRAY(svp[0]);
AV *av;
for ( ;ix > 0; ix--) {
if (names_fill >= ix && names[ix] != &PL_sv_undef) {
const char sigil = SvPVX_const(names[ix])[0];
- if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
+ if ((SvFLAGS(names[ix]) & SVf_FAKE)
+ || (SvFLAGS(names[ix]) & SVpad_STATE)
+ || sigil == '&')
+ {
/* outer lexical or anon code */
av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
}
else { /* our own lexical */
SV *sv;
if (sigil == '@')
- sv = (SV*)newAV();
+ sv = MUTABLE_SV(newAV());
else if (sigil == '%')
- sv = (SV*)newHV();
+ sv = MUTABLE_SV(newHV());
else
sv = newSV(0);
av_store(newpad, ix, sv);
}
av = newAV();
av_extend(av, 0);
- av_store(newpad, 0, (SV*)av);
+ av_store(newpad, 0, MUTABLE_SV(av));
AvREIFY_only(av);
- av_store(padlist, depth, (SV*)newpad);
+ av_store(padlist, depth, MUTABLE_SV(newpad));
AvFILLp(padlist) = depth;
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff