perlunicode.pod: Add detail on utf8/locale conflicts

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 05e13e5..2d4e2ab 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3607,13 +3607,18 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
         }
         /* If source has a real method, then a method is
            going to change */
-        else if(GvCV((const GV *)sstr)) {
+        else if(
+         GvCV((const GV *)sstr) && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+        ) {
             mro_changes = 1;
         }
     }
 
     /* If dest already had a real method, that's a change as well */
-    if(!mro_changes && GvGP(MUTABLE_GV(dstr)) && GvCVu((const GV *)dstr)) {
+    if(
+        !mro_changes && GvGP(MUTABLE_GV(dstr)) && GvCVu((const GV *)dstr)
+     && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+    ) {
         mro_changes = 1;
     }
 
@@ -3621,7 +3626,12 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        glob to begin with. */
     if(dtype == SVt_PVGV) {
         const char * const name = GvNAME((const GV *)dstr);
-        if(strEQ(name,"ISA"))
+        if(
+            strEQ(name,"ISA")
+         /* The stash may have been detached from the symbol table, so
+            check its name. */
+         && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+        )
             mro_changes = 2;
         else {
             const STRLEN len = GvNAMELEN(dstr);
@@ -3656,7 +3666,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
@@ -3773,7 +3783,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,
@@ -3781,7 +3791,12 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
                );
            }
        }
-       else if (stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")) {
+       else if (
+           stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")
+        /* The stash may have been detached from the symbol table, so
+           check its name before doing anything. */
+        && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+       ) {
            sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
            mro_isa_changed_in(GvSTASH(dstr));
        }
@@ -4043,7 +4058,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,
@@ -5558,7 +5573,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);
@@ -5991,7 +6006,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
        case SVt_PVGV:
            if (isGV_with_GP(sv)) {
                if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))
-                  && HvNAME_get(stash))
+                  && HvENAME_get(stash))
                    mro_method_changed_in(stash);
                gp_free(MUTABLE_GV(sv));
                if (GvNAME_HEK(sv))
@@ -7323,11 +7338,13 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
            }
        } else if (SvUTF8(sv)) {
            SV * const tsv = newSV(0);
+           ENTER;
+           SAVEFREESV(tsv);
            sv_gets(tsv, fp, 0);
            sv_utf8_upgrade_nomg(tsv);
            SvCUR_set(sv,append);
            sv_catsv(sv,tsv);
-           sv_free(tsv);
+           LEAVE;
            goto return_string_or_null;
        }
     }
@@ -11009,10 +11026,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];
@@ -11022,15 +11040,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) */
@@ -11098,14 +11121,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 */
@@ -11661,7 +11687,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)  */
@@ -11735,7 +11761,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);
@@ -11791,7 +11820,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;
@@ -12196,6 +12226,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);
@@ -12520,7 +12554,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);