Re: Named-capture regex syntax

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

diff --git a/pad.c b/pad.c
index 95a8d42..4ff62e2 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -74,7 +74,7 @@ in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 The SVs in the names AV have their PV being the name of the variable.
 NV+1..IV inclusive 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_PVGV, with the MAGIC slot
+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 sometimes
 hijacked to store the generation number during compilation.
@@ -109,6 +109,7 @@ to be generated in evals, such as
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"
+#include "keywords.h"
 
 
 #define PAD_MAX 999999999
@@ -333,7 +334,7 @@ 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)
+Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
 {
     dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
@@ -346,6 +347,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     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));
     }
@@ -354,6 +356,9 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
        OURSTASH_set(namesv, ourstash);
        SvREFCNT_inc_simple_void_NN(ourstash);
     }
+    else if (state) {
+       SvPAD_STATE_on(namesv);
+    }
 
     av_store(PL_comppad_name, offset, namesv);
     if (fake) {
@@ -539,7 +544,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" : "my"),
+               (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"),
                name,
                (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
            --off;
@@ -845,7 +850,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            SvPAD_TYPED(*out_name_sv)
                    ? SvSTASH(*out_name_sv) : NULL,
            OURSTASH(*out_name_sv),
-           1  /* fake */
+           1,  /* fake */
+           0   /* not a state variable */
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
@@ -853,7 +859,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
        SvNV_set(new_namesv, (NV)0);
        if (SvPAD_OUR(new_namesv)) {
-           /*EMPTY*/;   /* do nothing */
+           NOOP;   /* do nothing */
        }
        else if (CvLATE(cv)) {
            /* delayed creation - just note the offset within parent pad */
@@ -1031,7 +1037,8 @@ Perl_pad_leavemy(pTHX)
            if (sv && sv != &PL_sv_undef
                    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                                       "%"SVf" never introduced", sv);
+                           "%"SVf" never introduced",
+                           (void*)sv);
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */