Add a define PERL_POISON which tries to trip up anything accessing

freed or uninitialised memory. Currently only Poison()s freed
pointers.

p4raw-id: //depot/perl@24959

diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 125978b..d4b47cf 100644 (file)
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -309,7 +309,7 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
        else {
            /* Create a "dummy" SV to represent the available data from layer below */
            if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
-               Safefree(SvPVX_const(e->dataSV));
+               Safefree(SvPVX_mutable(e->dataSV));
            }
            if (use > (SSize_t)e->base.bufsiz) {
                if (e->flags & NEEDS_LINES) {

diff --git a/gv.c b/gv.c
index 6fb877d..aaae2a2 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -120,7 +120,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
            SvLEN_set(gv, 0);
            SvPOK_off(gv);
        } else
-           Safefree(SvPVX_const(gv));
+           Safefree(SvPVX_mutable(gv));
     }
     Newz(602, gp, 1, GP);
     GvGP(gv) = gp_ref(gp);

diff --git a/handy.h b/handy.h
index 534e92e..0a2c50e 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -626,7 +626,13 @@ hopefully catches attempts to access uninitialized memory.
          (v = (MEM_WRAP_CHECK_(n,t) (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
 #define Renewc(v,n,t,c) \
          (v = (MEM_WRAP_CHECK_(n,t) (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
+
+#ifdef PERL_POISON
+#define Safefree(d) \
+  (d ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0)
+#else
 #define Safefree(d)    safefree((Malloc_t)(d))
+#endif
 
 #define Move(s,d,n,t)  (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
 #define Copy(s,d,n,t)  (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))

diff --git a/pp_ctl.c b/pp_ctl.c
index b6c72e8..d39d356 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -371,7 +371,14 @@ Perl_rxres_free(pTHX_ void **rsp)
     UV *p = (UV*)*rsp;
 
     if (p) {
+#ifdef PERL_POISON
+       void *tmp = INT2PTR(char*,*p);
+       Safefree(tmp);
+       if (*p)
+           Poison(*p, 1, sizeof(*p));
+#else
        Safefree(INT2PTR(char*,*p));
+#endif
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (p[1]) {
            SvREFCNT_dec (INT2PTR(SV*,p[1]));

diff --git a/scope.c b/scope.c
index 7e2b129..e656ff9 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -781,7 +781,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            gv = (GV*)SSPOPPTR;
            if (SvPVX_const(gv) && SvLEN(gv) > 0) {
-               Safefree(SvPVX_const(gv));
+               Safefree(SvPVX_mutable(gv));
            }
            SvPV_set(gv, (char *)SSPOPPTR);
            SvCUR_set(gv, (STRLEN)SSPOPIV);

diff --git a/sv.c b/sv.c
index 13a51f1..21ac641 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4129,13 +4129,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
             }
 #endif
             /* Initial code is common.  */
-           if (SvPVX_const(dstr)) {            /* we know that dtype >= SVt_PV */
-               if (SvOOK(dstr)) {
-                   SvFLAGS(dstr) &= ~SVf_OOK;
-                   Safefree(SvPVX_const(dstr) - SvIVX(dstr));
-               }
-               else if (SvLEN(dstr))
-                   Safefree(SvPVX_const(dstr));
+           if (SvPVX_const(dstr)) {    /* we know that dtype >= SVt_PV */
+               SvPV_free(dstr);
            }
 
             if (!isSwipe) {
@@ -5603,7 +5598,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
        }
 #else
        else if (SvPVX_const(sv) && SvLEN(sv))
-           Safefree(SvPVX_const(sv));
+           Safefree(SvPVX_mutable(sv));
        else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
            unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
            SvFAKE_off(sv);