Squeeze the context type down to 4 bits, and move the private flags to

[p5sagit/p5-mst-13.2.git] / pad.c

diff --git a/pad.c b/pad.c
index 8560d9a..ea27408 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
 */
 
@@ -168,7 +170,7 @@ Perl_pad_new(pTHX_ int flags)
            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);
            }
@@ -255,8 +257,8 @@ Perl_pad_undef(pTHX_ CV* cv)
        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
@@ -550,7 +552,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",
-               (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;
@@ -768,6 +770,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 +799,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 +858,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];
@@ -1494,17 +1499,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;
                }
-               else {
-                   assert(!SvPADSTALE(sv));
+               else 
                    SvREFCNT_inc_simple_void_NN(sv);
-               }
            }
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
@@ -1517,6 +1522,9 @@ Perl_cv_clone(pTHX_ CV *proto)
                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])) {