perlunicode.pod: Add detail on utf8/locale conflicts

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 13fc40e..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,
@@ -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;
        }
     }
@@ -11744,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);
@@ -12206,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);
@@ -12530,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);