fix broken 5.14 code
Lukas Mai [Fri, 22 Jun 2012 09:17:05 +0000 (11:17 +0200)]
padop_on_crack.c.inc

index 7faf7a4..4f229f1 100644 (file)
@@ -689,11 +689,13 @@ static PADOFFSET S_pad_alloc(pTHX_ I32 optype, U32 tmptype) {
 #define pad_add_name_sv(NAMESV, FLAGS, TYPESTASH, OURSTASH) \
        S_pad_add_name_sv(aTHX_ NAMESV, FLAGS, TYPESTASH, OURSTASH)
 
-static PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash) {
+static PADOFFSET S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash) {
        dVAR;
        const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 
-       ASSERT_CURPAD_ACTIVE("pad_add_name");
+       assert(flags == 0);
+
+       ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 
        if (typestash) {
                assert(SvTYPE(namesv) == SVt_PVMG);
@@ -705,14 +707,53 @@ static PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typest
                SvOURSTASH_set(namesv, ourstash);
                SvREFCNT_inc_simple_void_NN(ourstash);
        }
-       #if 0
-       else if (flags & padadd_STATE) {
-               SvPAD_STATE_on(namesv);
-       }
-       #endif
 
        av_store(PL_comppad_name, offset, namesv);
        return offset;
 }
 
+PADOFFSET static S_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags, HV *typestash, HV *ourstash) {
+       dVAR;
+       PADOFFSET offset;
+       SV *namesv;
+
+       assert(flags == 0);
+
+       namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+       sv_setpvn(namesv, namepv, namelen);
+
+       offset = S_pad_alloc_name(aTHX_ namesv, flags, typestash, ourstash);
+
+       /* not yet introduced */
+       COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
+       COP_SEQ_RANGE_HIGH_set(namesv, 0);
+
+       if (!PL_min_intro_pending)
+               PL_min_intro_pending = offset;
+       PL_max_intro_pending = offset;
+       /* if it's not a simple scalar, replace with an AV or HV */
+       assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
+       assert(SvREFCNT(PL_curpad[offset]) == 1);
+       if (namelen != 0 && *namepv == '@')
+               sv_upgrade(PL_curpad[offset], SVt_PVAV);
+       else if (namelen != 0 && *namepv == '%')
+               sv_upgrade(PL_curpad[offset], SVt_PVHV);
+       assert(SvPADMY(PL_curpad[offset]));
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                                                  "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+                                                  (long)offset, SvPVX(namesv),
+                                                  PTR2UV(PL_curpad[offset])));
+
+       return offset;
+}
+
+static PADOFFSET S_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash) {
+       char *namepv;
+       STRLEN namelen;
+       assert(flags == 0);
+       namepv = SvPV(name, namelen);
+       return S_pad_add_name_pvn(aTHX_ namepv, namelen, flags, typestash, ourstash);
+}
+
 #endif