Ressurect change 27824, which plugs a resource leak in uncalled code.

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 58bbad6..dcc7a89 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -678,6 +678,7 @@ Perl_sv_free_arenas(pTHX)
 void*
 Perl_get_arena(pTHX_ int arena_size)
 {
+    dVAR;
     struct arena_desc* adesc;
     struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
     int curr;
@@ -692,7 +693,7 @@ Perl_get_arena(pTHX_ int arena_size)
        newroot->set_size = ARENAS_PER_SET;
        newroot->next = *aroot;
        *aroot = newroot;
-       DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", *aroot));
+       DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)*aroot));
     }
 
     /* ok, now have arena-set with at least 1 empty/available arena-desc */
@@ -5076,10 +5077,8 @@ Perl_sv_clear(pTHX_ register SV *sv)
        }
     }
     if (type >= SVt_PVMG) {
-       HV *ourstash;
-       if ((type == SVt_PVMG || type == SVt_PVGV) &&
-           (ourstash = OURSTASH(sv))) {
-           SvREFCNT_dec(ourstash);
+       if ((type == SVt_PVMG || type == SVt_PVGV) && SvPAD_OUR(sv)) {
+           SvREFCNT_dec(OURSTASH(sv));
        } else if (SvMAGIC(sv))
            mg_free(sv);
        if (type == SVt_PVMG && SvPAD_TYPED(sv))
@@ -5348,7 +5347,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
                        PL_utf8cache = 0;
                        Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVf
                                   " real %"UVf" for %"SVf,
-                                  (UV) ulen, (UV) real, sv);
+                                  (UV) ulen, (UV) real, (void*)sv);
                    }
                }
            }
@@ -5506,7 +5505,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *sv, MAGIC **mgp, const U8 *const start,
                PL_utf8cache = 0;
                Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVf
                           " real %"UVf" for %"SVf,
-                          (UV) boffset, (UV) real_boffset, sv);
+                          (UV) boffset, (UV) real_boffset, (void*)sv);
            }
        }
        boffset = real_boffset;
@@ -5639,7 +5638,7 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *sv, MAGIC **mgp, STRLEN byte, STRLEN utf8,
            SAVEI8(PL_utf8cache);
            PL_utf8cache = 0;
            Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVf
-                      " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, sv);
+                      " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
        }
     }
 
@@ -5886,7 +5885,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
                PL_utf8cache = 0;
                Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVf
                           " real %"UVf" for %"SVf,
-                          (UV) len, (UV) real_len, sv);
+                          (UV) len, (UV) real_len, (void*)sv);
            }
        }
        len = real_len;
@@ -6982,12 +6981,15 @@ Perl_newSVhek(pTHX_ const HEK *hek)
            SvUTF8_on (sv);
            Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
            return sv;
-       } else if (flags & HVhek_REHASH) {
+       } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
            /* We don't have a pointer to the hv, so we have to replicate the
               flag into every HEK. This hv is using custom a hasing
               algorithm. Hence we can't return a shared string scalar, as
               that would contain the (wrong) hash value, and might get passed
-              into an hv routine with a regular hash  */
+              into an hv routine with a regular hash.
+              Similarly, a hash that isn't using shared hash keys has to have
+              the flag in every key so that we know not to try to call
+              share_hek_kek on it.  */
 
            SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
            if (HEK_UTF8(hek))
@@ -7369,7 +7371,7 @@ Perl_sv_2io(pTHX_ SV *sv)
        else
            io = 0;
        if (!io)
-           Perl_croak(aTHX_ "Bad filehandle: %"SVf, sv);
+           Perl_croak(aTHX_ "Bad filehandle: %"SVf, (void*)sv);
        break;
     }
     return io;
@@ -7461,7 +7463,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
            LEAVE;
            if (!GvCVu(gv))
                Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
-                          sv);
+                          (void*)sv);
        }
        return GvCVu(gv);
     }
@@ -9323,7 +9325,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                                       (UV)c & 0xFF);
                } else
                    sv_catpvs(msg, "end of string");
-               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
+               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, (void*)msg); /* yes, this is reentrant */
            }
 
            /* output mangled stuff ... */
@@ -9644,7 +9646,7 @@ Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
     ret->gp_cv         = cv_dup_inc(gp->gp_cv, param);
     ret->gp_cvgen      = gp->gp_cvgen;
     ret->gp_line       = gp->gp_line;
-    ret->gp_file       = gp->gp_file;          /* points to COP.cop_file */
+    ret->gp_file_hek   = hek_dup(gp->gp_file_hek, param);
     return ret;
 }
 
@@ -10040,9 +10042,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
               missing by always going for the destination.
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
-               HV *ourstash;
-               if ((sv_type == SVt_PVMG) && (ourstash = OURSTASH(dstr))) {
-                   OURSTASH_set(dstr, hv_dup_inc(ourstash, param));
+               if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
+                   OURSTASH_set(dstr, hv_dup_inc(OURSTASH(dstr), param));
                } else if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
                if (SvSTASH(dstr))
@@ -11752,16 +11753,17 @@ STATIC I32
 S_find_array_subscript(pTHX_ AV *av, SV* val)
 {
     dVAR;
-    SV** svp;
-    I32 i;
     if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
                        (AvFILLp(av) > FUV_MAX_SEARCH_SIZE))
        return -1;
 
-    svp = AvARRAY(av);
-    for (i=AvFILLp(av); i>=0; i--) {
-       if (svp[i] == val && svp[i] != &PL_sv_undef)
-           return i;
+    if (val != &PL_sv_undef) {
+       SV ** const svp = AvARRAY(av);
+       I32 i;
+
+       for (i=AvFILLp(av); i>=0; i--)
+           if (svp[i] == val)
+               return i;
     }
     return -1;
 }