This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Zero-ing the new HV array is pointless, as we write to every element.
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index df40915..30aa440 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -534,7 +534,7 @@ Perl_sv_free_arenas(pTHX)
            svanext = (SV*) SvANY(svanext);
 
        if (!SvFAKE(sva))
-           Safefree((void *)sva);
+           Safefree(sva);
     }
 
     for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
@@ -1867,7 +1867,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        break;
     case SVt_PVHV:
        SvANY(sv) = new_XPVHV();
-       ((XPVHV*) SvANY(sv))->xhv_aux = 0;
        HvFILL(sv)      = 0;
        HvMAX(sv)       = 0;
        HvTOTALKEYS(sv) = 0;
@@ -1983,6 +1982,8 @@ int
 Perl_sv_backoff(pTHX_ register SV *sv)
 {
     assert(SvOOK(sv));
+    assert(SvTYPE(sv) != SVt_PVHV);
+    assert(SvTYPE(sv) != SVt_PVAV);
     if (SvIVX(sv)) {
        char *s = SvPVX(sv);
        SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
@@ -4949,7 +4950,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
     if (SvREADONLY(sv)) {
        if (SvFAKE(sv)) {
            char *pvx = SvPVX(sv);
-           int is_utf8 = SvUTF8(sv);
+           const int is_utf8 = SvUTF8(sv);
            STRLEN len = SvCUR(sv);
             U32 hash   = SvUVX(sv);
            SvFAKE_off(sv);
@@ -10921,51 +10922,42 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
        SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
        {
-           struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux;
            HEK *hvname = 0;
 
-           if (aux) {
-               I32 riter = aux->xhv_riter;
-
-               hvname = aux->xhv_name;
-               if (hvname || riter != -1) {
-                   struct xpvhv_aux *d_aux;
-
-                   New(0, d_aux, 1, struct xpvhv_aux);
-
-                   d_aux->xhv_riter = riter;
-                   d_aux->xhv_eiter = 0;
-                   d_aux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
-
-                   ((XPVHV *)SvANY(dstr))->xhv_aux = d_aux;
-               } else {
-                   ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
-               }
-           }
-           else {
-               ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
-           }
            if (HvARRAY((HV*)sstr)) {
                STRLEN i = 0;
+               bool sharekeys = !!HvSHAREKEYS(sstr);
                XPVHV *dxhv = (XPVHV*)SvANY(dstr);
                XPVHV *sxhv = (XPVHV*)SvANY(sstr);
                char *darray;
-               /* FIXME - surely this doesn't need to be zeroed?  */
-               Newz(0, darray,
-                    PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+               New(0, darray,
+                    PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+                    + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0), char);
                HvARRAY(dstr) = (HE**)darray;
                while (i <= sxhv->xhv_max) {
+                   HE *source = HvARRAY(sstr)[i];
                    HvARRAY(dstr)[i]
-                       = he_dup(HvARRAY(sstr)[i],
-                                (bool)!!HvSHAREKEYS(sstr), param);
+                       = source ? he_dup(source, sharekeys, param) : 0;
                    ++i;
                }
-               HvEITER_set(dstr, he_dup(HvEITER_get(sstr),
-                                        (bool)!!HvSHAREKEYS(sstr), param));
+               if (SvOOK(sstr)) {
+                   struct xpvhv_aux *saux = HvAUX(sstr);
+                   struct xpvhv_aux *daux = HvAUX(dstr);
+                   /* This flag isn't copied.  */
+                   /* SvOOK_on(hv) attacks the IV flags.  */
+                   SvFLAGS(dstr) |= SVf_OOK;
+
+                   hvname = saux->xhv_name;
+                   daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+
+                   daux->xhv_riter = saux->xhv_riter;
+                   daux->xhv_eiter = saux->xhv_eiter
+                       ? he_dup(saux->xhv_eiter, (bool)!!HvSHAREKEYS(sstr),
+                                param) : 0;
+               }
            }
            else {
                SvPV_set(dstr, Nullch);
-               HvEITER_set((HV*)dstr, (HE*)NULL);
            }
            /* Record stashes for possible cloning in Perl_clone(). */
            if(hvname)
@@ -11219,6 +11211,9 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
     OP *o;
+    /* Unions for circumventing strict ANSI C89 casting rules. */
+    union { void *vptr; void (*dptr)(void*); } u1, u2;
+    union { void *vptr; void (*dxptr)(pTHX_ void*); } u3, u4;
 
     Newz(54, nss, max, ANY);
 
@@ -11390,13 +11385,17 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);  /* XXX quite arbitrary */
            dptr = POPDPTR(ss,ix);
-           TOPDPTR(nss,ix) = (void (*)(void*))any_dup((void *)dptr, proto_perl);
+           u1.dptr = dptr;
+           u2.vptr = any_dup(u1.vptr, proto_perl);
+           TOPDPTR(nss,ix) = u2.dptr;
            break;
        case SAVEt_DESTRUCTOR_X:
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);  /* XXX quite arbitrary */
            dxptr = POPDXPTR(ss,ix);
-           TOPDXPTR(nss,ix) = (void (*)(pTHX_ void*))any_dup((void *)dxptr, proto_perl);
+           u3.dxptr = dxptr;
+           u4.vptr = any_dup(u3.vptr, proto_perl);;
+           TOPDXPTR(nss,ix) = u4.dxptr;
            break;
        case SAVEt_REGCONTEXT:
        case SAVEt_ALLOC: