From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 21 Jul 1998 00:39:17 +0000 (+0000)
Subject: fix small memory leak when mess_sv happens to be touched by magic
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c63ababe730a679456af7dbae670cea805c3751;p=p5sagit%2Fp5-mst-13.2.git

fix small memory leak when mess_sv happens to be touched by magic

p4raw-id: //depot/perl@1585
---

diff --git a/perl.c b/perl.c
index bebcb02..df306dc 100644
--- a/perl.c
+++ b/perl.c
@@ -567,6 +567,17 @@ perl_destruct(register PerlInterpreter *sv_interp)
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
+	/* it could have accumulated taint magic */
+	if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
+	    MAGIC* mg;
+	    MAGIC* moremagic;
+	    for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+		moremagic = mg->mg_moremagic;
+		if (mg->mg_ptr && mg->mg_type != 'g' && mg->mg_len >= 0)
+		    Safefree(mg->mg_ptr);
+		Safefree(mg);
+	    }
+	}
 	/* we know that type >= SVt_PV */
 	SvOOK_off(PL_mess_sv);
 	Safefree(SvPVX(PL_mess_sv));
diff --git a/t/lib/thread.t b/t/lib/thread.t
index fecfb03..83407a9 100755
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
@@ -8,7 +8,9 @@ BEGIN {
 	print "1..0\n";
 	exit 0;
     }
-    $ENV{PERL_DESTRUCT_LEVEL} = 0;	# XXX known trouble with global destruction
+
+    # XXX known trouble with global destruction
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 }
 $| = 1;
 print "1..14\n";
diff --git a/t/op/local.t b/t/op/local.t
index f8c037d..2f674d1 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -4,7 +4,8 @@
 
 print "1..58\n";
 
-$ENV{PERL_DESTRUCT_LEVEL} = 0; # XXX known to leaks scalars
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 
 sub foo {
     local($a, $b) = @_;
diff --git a/t/op/pat.t b/t/op/pat.t
index ef014f2..f16783e 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -12,7 +12,8 @@ BEGIN {
 }
 eval 'use Config';          #  Defaults assumed if this fails
 
-$ENV{PERL_DESTRUCT_LEVEL} = 0; # XXX known to leaks scalars
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 
 $x = "abc\ndef\n";
 
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 4ebb8c0..0ec069b 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -1,6 +1,7 @@
 #!./perl
 
-$ENV{PERL_DESTRUCT_LEVEL} = 0; # XXX known to leaks scalars
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 
 # The tests are in a separate file 't/op/re_tests'.
 # Each line in that file is a separate test.