add SAVEFREECOPHH()

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index fa6b8fb..3c13a46 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3028,8 +3028,9 @@ Perl_sv_2pvbyte(pTHX_ register SV *const sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
+    SvGETMAGIC(sv);
     sv_utf8_downgrade(sv,0);
-    return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
+    return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 
 /*
@@ -3655,7 +3656,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
     if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
     else if(mro_changes == 3) {
        HV * const stash = GvHV(dstr);
-       if(old_stash ? (HV *)HvNAME(old_stash) : stash)
+       if(old_stash ? (HV *)HvENAME_get(old_stash) : stash)
            mro_package_moved(
                stash, old_stash,
                (GV *)dstr, NULL, 0
@@ -3772,7 +3773,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            const STRLEN len = GvNAMELEN(dstr);
            if (
                len > 1 && name[len-2] == ':' && name[len-1] == ':'
-            && (!dref || HvNAME(dref))
+            && (!dref || HvENAME_get(dref))
            ) {
                mro_package_moved(
                    (HV *)sref, (HV *)dref,
@@ -3932,22 +3933,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        /* case SVt_BIND: */
     case SVt_PVLV:
     case SVt_PVGV:
-       if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
-           glob_assign_glob(dstr, sstr, dtype);
-           return;
-       }
        /* SvVALID means that this PVGV is playing at being an FBM.  */
-       /*FALLTHROUGH*/
 
     case SVt_PVMG:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
            if (SvTYPE(sstr) != stype)
                stype = SvTYPE(sstr);
-           if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
+       }
+       if (isGV_with_GP(sstr) && dtype <= SVt_PVLV) {
                    glob_assign_glob(dstr, sstr, dtype);
                    return;
-           }
        }
        if (stype == SVt_PVLV)
            SvUPGRADE(dstr, SVt_PVNV);
@@ -4047,7 +4043,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                if (reset_isa) {
                    HV * const stash = GvHV(dstr);
                    if(
-                       old_stash ? (HV *)HvNAME(old_stash) : stash
+                       old_stash ? (HV *)HvENAME_get(old_stash) : stash
                    )
                        mro_package_moved(
                         stash, old_stash,
@@ -5562,7 +5558,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
                        /* You lookin' at me?  */
                        assert(CvSTASH(referrer));
                        assert(CvSTASH(referrer) == (const HV *)sv);
-                       CvSTASH(referrer) = 0;
+                       SvANY(MUTABLE_CV(referrer))->xcv_stash = 0;
                    }
                    else {
                        assert(SvTYPE(sv) == SVt_PVGV);
@@ -11013,10 +11009,11 @@ Perl_fp_dup(pTHX_ PerlIO *const fp, const char type, CLONE_PARAMS *const param)
 /* duplicate a directory handle */
 
 DIR *
-Perl_dirp_dup(pTHX_ DIR *const dp)
+Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
 {
-#ifdef HAS_FCHDIR
     DIR *ret;
+
+#ifdef HAS_FCHDIR
     DIR *pwd;
     register const Direntry_t *dirent;
     char smallbuf[256];
@@ -11026,15 +11023,20 @@ Perl_dirp_dup(pTHX_ DIR *const dp)
 #endif
 
     PERL_UNUSED_CONTEXT;
+    PERL_ARGS_ASSERT_DIRP_DUP;
 
-#ifdef HAS_FCHDIR
     if (!dp)
        return (DIR*)NULL;
+
     /* look for it in the table first */
     ret = (DIR*)ptr_table_fetch(PL_ptr_table, dp);
     if (ret)
        return ret;
 
+#ifdef HAS_FCHDIR
+
+    PERL_UNUSED_ARG(param);
+
     /* create anew */
 
     /* open the current directory (so we can switch back) */
@@ -11102,14 +11104,17 @@ Perl_dirp_dup(pTHX_ DIR *const dp)
 
     if (name && name != smallbuf)
        Safefree(name);
+#endif
+
+#ifdef WIN32
+    ret = win32_dirp_dup(dp, param);
+#endif
 
     /* pop it in the pointer table */
-    ptr_table_store(PL_ptr_table, dp, ret);
+    if (ret)
+       ptr_table_store(PL_ptr_table, dp, ret);
 
     return ret;
-#else
-    return (DIR*)NULL;
-#endif
 }
 
 /* duplicate a typeglob */
@@ -11665,7 +11670,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                    IoFMT_GV(dstr)      = gv_dup(IoFMT_GV(dstr), param);
                    IoBOTTOM_GV(dstr)   = gv_dup(IoBOTTOM_GV(dstr), param);
                    if (IoDIRP(dstr)) {
-                       IoDIRP(dstr)    = dirp_dup(IoDIRP(dstr));
+                       IoDIRP(dstr)    = dirp_dup(IoDIRP(dstr), param);
                    } else {
                        NOOP;
                        /* IoDIRP(dstr) is already a copy of IoDIRP(sstr)  */
@@ -11739,7 +11744,10 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                        hvname = saux->xhv_name;
                        if (saux->xhv_name_count) {
                            HEK ** const sname = (HEK **)saux->xhv_name;
-                           const U32 count = saux->xhv_name_count;
+                           const I32 count
+                            = saux->xhv_name_count < 0
+                               ? -saux->xhv_name_count
+                               :  saux->xhv_name_count;
                            HEK **shekp = sname + count;
                            HEK **dhekp;
                            Newxc(daux->xhv_name, count, HEK *, HEK);
@@ -11795,7 +11803,8 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                /*FALLTHROUGH*/
            case SVt_PVFM:
                /* NOTE: not refcounted */
-               CvSTASH(dstr)   = hv_dup(CvSTASH(dstr), param);
+               SvANY(MUTABLE_CV(dstr))->xcv_stash =
+                   hv_dup(CvSTASH(dstr), param);
                if ((param->flags & CLONEf_JOIN_IN) && CvSTASH(dstr))
                    Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(dstr)), dstr);
                OP_REFCNT_LOCK;
@@ -12200,6 +12209,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            else
                TOPPTR(nss,ix) = NULL;
            break;
+       case SAVEt_FREECOPHH:
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = cophh_copy((COPHH *)ptr);
+           break;
        case SAVEt_DELETE:
            hv = (const HV *)POPPTR(ss,ix);
            TOPPTR(nss,ix) = hv_dup_inc(hv, param);
@@ -12524,7 +12537,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     param->proto_perl = proto_perl;
     /* Likely nothing will use this, but it is initialised to be consistent
        with Perl_clone_params_new().  */
-    param->proto_perl = my_perl;
+    param->new_perl = my_perl;
     param->unreferenced = NULL;
 
     INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);