diff options
| -rw-r--r-- | perl.c | 11 | ||||
| -rwxr-xr-x | t/lib/thread.t | 4 | ||||
| -rwxr-xr-x | t/op/local.t | 3 | ||||
| -rwxr-xr-x | t/op/pat.t | 3 | ||||
| -rwxr-xr-x | t/op/regexp.t | 3 |
5 files changed, 20 insertions, 4 deletions
@@ -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 fecfb0304a..83407a9fab 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 f8c037d4bf..2f674d103b 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 ef014f2562..f16783ede9 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 4ebb8c073d..0ec069b19a 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. |