Re: [perl #37731] junk and uninit'ed values in tied scalars

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

diff --git a/sv.c b/sv.c
index a1b8003..32939d2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1032,7 +1032,7 @@ static const struct body_details bodies_by_type[] = {
 #define new_NOARENAZ(details) \
        my_safecalloc((details)->body_size + (details)->offset)
 
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
 static bool done_sanity_check;
 #endif
 
@@ -1048,7 +1048,9 @@ S_more_bodies (pTHX_ svtype sv_type)
 
     assert(bdp->arena_size);
 
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
+    /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
+     * variables like done_sanity_check. */
     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;
 
@@ -1448,10 +1450,10 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
                return s;
            } else
 #endif
-           s = saferealloc(s, newlen);
+           s = (char*)saferealloc(s, newlen);
        }
        else {
-           s = safemalloc(newlen);
+           s = (char*)safemalloc(newlen);
            if (SvPVX_const(sv) && SvCUR(sv)) {
                Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
            }
@@ -2686,7 +2688,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                s = SvGROW_mutable(sv, len + 1);
                SvCUR_set(sv, len);
                SvPOKp_on(sv);
-               return memcpy(s, tbuf, len + 1);
+               return (char*)memcpy(s, tbuf, len + 1);
            }
        }
         if (SvROK(sv)) {
@@ -2798,7 +2800,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        /* some Xenix systems wipe out errno here */
 #ifdef apollo
        if (SvNVX(sv) == 0.0)
-           (void)strcpy(s,"0");
+           my_strlcpy(s, "0", SvLEN(sv));
        else
 #endif /*apollo*/
        {
@@ -2807,7 +2809,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO
         if (*s == '-' && s[1] == '0' && !s[2])
-           strcpy(s,"0");
+           my_strlcpy(s, "0", SvLEN(s));
 #endif
        while (*s) s++;
 #ifdef hcx
@@ -3315,9 +3317,10 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
                                         || sv_cmp(cv_const_sv(cv),
                                                   cv_const_sv((CV*)sref))))) {
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                                       CvCONST(cv)
-                                       ? "Constant subroutine %s::%s redefined"
-                                       : "Subroutine %s::%s redefined",
+                                       (const char *)
+                                       (CvCONST(cv)
+                                        ? "Constant subroutine %s::%s redefined"
+                                        : "Subroutine %s::%s redefined"),
                                        HvNAME_get(GvSTASH((GV*)dstr)),
                                        GvENAME((GV*)dstr));
                        }
@@ -3935,8 +3938,10 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     if (SvPVX_const(sv))
        SvPV_free(sv);
 
+#ifdef DEBUGGING
     if (flags & SV_HAS_TRAILING_NUL)
        assert(ptr[len] == '\0');
+#endif
 
     allocate = (flags & SV_HAS_TRAILING_NUL)
        ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
@@ -3946,13 +3951,13 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     } else {
 #ifdef DEBUGGING
        /* Force a move to shake out bugs in callers.  */
-       char *new_ptr = safemalloc(allocate);
+       char *new_ptr = (char*)safemalloc(allocate);
        Copy(ptr, new_ptr, len, char);
        PoisonFree(ptr,len,char);
        Safefree(ptr);
        ptr = new_ptr;
 #else
-       ptr = saferealloc (ptr, allocate);
+       ptr = (char*) saferealloc (ptr, allocate);
 #endif
     }
     SvPV_set(sv, ptr);
@@ -4644,7 +4649,8 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
 Weaken a reference: set the C<SvWEAKREF> flag on this RV; give the
 referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
 push a back-reference to this RV onto the array of backreferences
-associated with that magic.
+associated with that magic. If the RV is magical, set magic will be
+called after the RV is cleared.
 
 =cut
 */
@@ -4797,6 +4803,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *sv, AV *av)
                    SvRV_set(referrer, 0);
                    SvOK_off(referrer);
                    SvWEAKREF_off(referrer);
+                   SvSETMAGIC(referrer);
                } else if (SvTYPE(referrer) == SVt_PVGV ||
                           SvTYPE(referrer) == SVt_PVLV) {
                    /* You lookin' at me?  */
@@ -5921,8 +5928,16 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
        pv1 = "";
        cur1 = 0;
     }
-    else
+    else {
+       /* if pv1 and pv2 are the same, second SvPV_const call may
+        * invalidate pv1, so we may need to make a copy */
+       if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
+           pv1 = SvPV_const(sv1, cur1);
+           sv1 = sv_2mortal(newSVpvn(pv1, cur1));
+           if (SvUTF8(sv2)) SvUTF8_on(sv1);
+       }
        pv1 = SvPV_const(sv1, cur1);
+    }
 
     if (!sv2){
        pv2 = "";