From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 23 Jun 2005 14:11:20 +0000 (+0000)
Subject: Add a define PERL_POISON which tries to trip up anything accessing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=94010e71b67db04027249ff69e2a2bfa9a050945;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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);