/* pad.c
*
- * Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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.
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
+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.
{ my $x = 1; sub f { eval '$x'} } f();
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
=cut
*/
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);
}
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 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
{
dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
- SV* const namesv = newSV(0);
+ SV* const namesv
+ = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
ASSERT_CURPAD_ACTIVE("pad_add_name");
-
- sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
sv_setpv(namesv, name);
if (typestash) {
}
if (ourstash) {
SvPAD_OUR_on(namesv);
- OURSTASH_set(namesv, ourstash);
+ SvOURSTASH_set(namesv, ourstash);
SvREFCNT_inc_simple_void_NN(ourstash);
}
else if (state) {
{
dVAR;
PADOFFSET ix;
- SV* const name = newSV(0);
+ SV* const name = newSV_type(SVt_PVNV);
pad_peg("add_anon");
- sv_upgrade(name, SVt_PVNV);
sv_setpvn(name, "&", 1);
/* Are these two actually ever read? */
COP_SEQ_RANGE_HIGH_set(name, ~0);
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"),
+ (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
name,
(COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
--off;
&& 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),
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),
"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
PTR2UV(cv), PTR2UV(*out_capture)));
- if (SvPADSTALE(*out_capture)) {
+ if (SvPADSTALE(*out_capture)
+ && !SvPAD_STATE(name_svp[offset]))
+ {
if (ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" is not available", name);
SvPVX_const(*out_name_sv),
SvPAD_TYPED(*out_name_sv)
? SvSTASH(*out_name_sv) : NULL,
- OURSTASH(*out_name_sv),
+ SvOURSTASH(*out_name_sv),
1, /* fake */
- 0 /* not a state variable */
+ SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
&& !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"%"SVf" never introduced",
- (void*)sv);
+ SVfARG(sv));
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
ENTER;
SAVESPTR(PL_compcv);
- cv = PL_compcv = (CV*)newSV(0);
- sv_upgrade((SV *)cv, SvTYPE(proto));
+ cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto));
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
CvCLONED_on(cv);
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)) {
+ /* 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)) {
if (ckWARN(WARN_CLOSURE))
Perl_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];
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])) {
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]));
}
projects / p5sagit/p5-mst-13.2.git / blobdiff