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 6e33495..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();
 
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
 =cut
 */
 
@@ -126,6 +128,9 @@ to be generated in evals, such as
 #ifdef PERL_MAD
 void pad_peg(const char* s) {
     static int pegcnt;
+
+    PERL_ARGS_ASSERT_PAD_PEG;
+
     pegcnt++;
 }
 #endif
@@ -248,6 +253,8 @@ Perl_pad_undef(pTHX_ CV* cv)
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 
+    PERL_ARGS_ASSERT_PAD_UNDEF;
+
     pad_peg("pad_undef");
     if (!padlist)
        return;
@@ -350,6 +357,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     SV* const namesv
        = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
 
+    PERL_ARGS_ASSERT_PAD_ADD_NAME;
+
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
     sv_setpv(namesv, name);
@@ -485,6 +494,9 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     dVAR;
     PADOFFSET ix;
     SV* const name = newSV_type(SVt_PVNV);
+
+    PERL_ARGS_ASSERT_PAD_ADD_ANON;
+
     pad_peg("add_anon");
     sv_setpvn(name, "&", 1);
     /* Are these two actually ever read? */
@@ -529,6 +541,8 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
     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 */
@@ -602,6 +616,8 @@ Perl_pad_findmy(pTHX_ const char *name)
     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);
@@ -683,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);
 
+    PERL_ARGS_ASSERT_PAD_FINDLEX;
+
     *out_flags = 0;
 
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -768,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)
+                        && !SvPAD_STATE(name_svp[offset])
                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
@@ -796,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)));
 
-                   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);
@@ -853,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 */
-           0   /* not a state variable */
+           SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
@@ -926,6 +947,9 @@ void
 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,
@@ -1315,6 +1339,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     SV **ppad;
     I32 ix;
 
+    PERL_ARGS_ASSERT_DO_DUMP_PAD;
+
     if (!padlist) {
        return;
     }
@@ -1384,6 +1410,8 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
     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,
@@ -1437,6 +1465,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     CV* outside;
     long depth;
 
+    PERL_ARGS_ASSERT_CV_CLONE;
+
     assert(!CvUNIQUE(proto));
 
     /* Since cloneable anon subs can be nested, CvOUTSIDE may point
@@ -1494,17 +1524,17 @@ Perl_cv_clone(pTHX_ CV *proto)
            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;
                }
-               /* 'my $x if $y' can leave $x stale even in an active sub */
-               else if (!SvPADSTALE(sv)) {
+               else 
                    SvREFCNT_inc_simple_void_NN(sv);
-               }
            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
@@ -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);
+
+    PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
     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_ARGS_ASSERT_PAD_PUSH;
+
     if (depth > AvFILLp(padlist)) {
        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();