This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Re-instate all the warnings checks that don't work on Win32, but with
[perl5.git]
/
pad.c
diff --git
a/pad.c
b/pad.c
index
415b59e
..
b5e39fa
100644
(file)
--- a/
pad.c
+++ b/
pad.c
@@
-102,6
+102,8
@@
to be generated in evals, such as
{ my $x = 1; sub f { eval '$x'} } f();
{ my $x = 1; sub f { eval '$x'} } f();
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
=cut
*/
=cut
*/
@@
-126,6
+128,9
@@
to be generated in evals, such as
#ifdef PERL_MAD
void pad_peg(const char* s) {
static int pegcnt;
#ifdef PERL_MAD
void pad_peg(const char* s) {
static int pegcnt;
+
+ PERL_ARGS_ASSERT_PAD_PEG;
+
pegcnt++;
}
#endif
pegcnt++;
}
#endif
@@
-168,7
+173,7
@@
Perl_pad_new(pTHX_ int flags)
SAVEI32(PL_comppad_name_fill);
SAVEI32(PL_min_intro_pending);
SAVEI32(PL_max_intro_pending);
SAVEI32(PL_comppad_name_fill);
SAVEI32(PL_min_intro_pending);
SAVEI32(PL_max_intro_pending);
- SAVE
I32
(PL_cv_has_eval);
+ SAVE
BOOL
(PL_cv_has_eval);
if (flags & padnew_SAVESUB) {
SAVEI32(PL_pad_reset_pending);
}
if (flags & padnew_SAVESUB) {
SAVEI32(PL_pad_reset_pending);
}
@@
-248,6
+253,8
@@
Perl_pad_undef(pTHX_ CV* cv)
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_PAD_UNDEF;
+
pad_peg("pad_undef");
if (!padlist)
return;
pad_peg("pad_undef");
if (!padlist)
return;
@@
-255,8
+262,8
@@
Perl_pad_undef(pTHX_ CV* cv)
return;
DEBUG_X(PerlIO_printf(Perl_debug_log,
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
);
/* detach any '&' anon children in the pad; if afterwards they
@@
-347,12
+354,13
@@
Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
{
dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
{
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")
;
+
PERL_ARGS_ASSERT_PAD_ADD_NAME
;
+ ASSERT_CURPAD_ACTIVE("pad_add_name");
- sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
sv_setpv(namesv, name);
if (typestash) {
sv_setpv(namesv, name);
if (typestash) {
@@
-485,9
+493,11
@@
Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
{
dVAR;
PADOFFSET ix;
{
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");
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);
sv_setpvn(name, "&", 1);
/* Are these two actually ever read? */
COP_SEQ_RANGE_HIGH_set(name, ~0);
@@
-531,6
+541,8
@@
Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
SV **svp;
PADOFFSET top, off;
SV **svp;
PADOFFSET top, off;
+ PERL_ARGS_ASSERT_PAD_CHECK_DUP;
+
ASSERT_CURPAD_ACTIVE("pad_check_dup");
if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
ASSERT_CURPAD_ACTIVE("pad_check_dup");
if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
@@
-552,7
+564,7
@@
Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
break; /* "our" masking "our" */
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"%s\" variable %s masks earlier declaration in same %s",
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;
name,
(COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
--off;
@@
-604,6
+616,8
@@
Perl_pad_findmy(pTHX_ const char *name)
const AV *nameav;
SV **name_svp;
const AV *nameav;
SV **name_svp;
+ PERL_ARGS_ASSERT_PAD_FINDMY;
+
pad_peg("pad_findmy");
offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
NULL, &out_sv, &out_flags);
pad_peg("pad_findmy");
offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
NULL, &out_sv, &out_flags);
@@
-685,6
+699,8
@@
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
SV **new_capturep;
const AV * const padlist = CvPADLIST(cv);
SV **new_capturep;
const AV * const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_PAD_FINDLEX;
+
*out_flags = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
*out_flags = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@
-770,6
+786,7
@@
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
else {
int newwarn = warn;
if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
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),
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
@@
-798,7
+815,9
@@
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
PTR2UV(cv), PTR2UV(*out_capture)));
"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);
if (ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" is not available", name);
@@
-855,7
+874,7
@@
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
? SvSTASH(*out_name_sv) : NULL,
SvOURSTASH(*out_name_sv),
1, /* fake */
? SvSTASH(*out_name_sv) : NULL,
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];
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
@@
-928,6
+947,9
@@
void
Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
{
dVAR;
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,
ASSERT_CURPAD_ACTIVE("pad_setsv");
DEBUG_X(PerlIO_printf(Perl_debug_log,
@@
-1317,6
+1339,8
@@
Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
SV **ppad;
I32 ix;
SV **ppad;
I32 ix;
+ PERL_ARGS_ASSERT_DO_DUMP_PAD;
+
if (!padlist) {
return;
}
if (!padlist) {
return;
}
@@
-1386,6
+1410,8
@@
S_cv_dump(pTHX_ const CV *cv, const char *title)
const CV * const outside = CvOUTSIDE(cv);
AV* const padlist = CvPADLIST(cv);
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,
PerlIO_printf(Perl_debug_log,
" %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
title,
@@
-1439,6
+1465,8
@@
Perl_cv_clone(pTHX_ CV *proto)
CV* outside;
long depth;
CV* outside;
long depth;
+ PERL_ARGS_ASSERT_CV_CLONE;
+
assert(!CvUNIQUE(proto));
/* Since cloneable anon subs can be nested, CvOUTSIDE may point
assert(!CvUNIQUE(proto));
/* Since cloneable anon subs can be nested, CvOUTSIDE may point
@@
-1457,8
+1485,7
@@
Perl_cv_clone(pTHX_ CV *proto)
ENTER;
SAVESPTR(PL_compcv);
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);
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
CvCLONED_on(cv);
@@
-1497,17
+1524,17
@@
Perl_cv_clone(pTHX_ CV *proto)
if (SvFAKE(namesv)) { /* lexical from outside? */
sv = outpad[PARENT_PAD_INDEX(namesv)];
assert(sv);
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;
}
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);
SvREFCNT_inc_simple_void_NN(sv);
- }
}
if (!sv) {
const char sigil = SvPVX_const(namesv)[0];
}
if (!sv) {
const char sigil = SvPVX_const(namesv)[0];
@@
-1520,6
+1547,9
@@
Perl_cv_clone(pTHX_ CV *proto)
else
sv = newSV(0);
SvPADMY_on(sv);
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])) {
}
}
else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
@@
-1580,6
+1610,8
@@
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
AV * const comppad = (AV*)AvARRAY(padlist)[1];
SV ** const namepad = AvARRAY(comppad_name);
SV ** const curpad = AvARRAY(comppad);
AV * const comppad = (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--) {
PERL_UNUSED_ARG(old_cv);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
@@
-1610,6
+1642,9
@@
void
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
dVAR;
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();
if (depth > AvFILLp(padlist)) {
SV** const svp = AvARRAY(padlist);
AV* const newpad = newAV();
@@
-1622,7
+1657,10
@@
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
for ( ;ix > 0; ix--) {
if (names_fill >= ix && names[ix] != &PL_sv_undef) {
const char sigil = SvPVX_const(names[ix])[0];
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]));
}
/* outer lexical or anon code */
av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
}