From 7b102d90616d2574b3c6a3d1942fcb59fc2aaefb Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Sun, 20 Apr 2003 05:45:48 +0300 Subject: [PATCH] Fix another segfault case (warn called from UNIVERSAL::DESTROY). Subject: Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD Date: Sun, 20 Apr 2003 02:45:48 +0300 Message-ID: <20030419234548.GA849@ratsnest.hole> and Date: Wed, 2 Apr 2003 07:52:28 +0300 Message-ID: <20030402045227.GA1023@ratsnest.hole> p4raw-id: //depot/perl@19300 --- pp_sys.c | 2 +- t/op/ref.t | 6 +++++- util.c | 2 +- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 3f1e0b7..be1675c 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -423,7 +423,7 @@ PP(pp_warn) tmpsv = TOPs; } tmps = SvPV(tmpsv, len); - if (!tmps || !len) { + if ((!tmps || !len) && PL_errgv) { SV *error = ERRSV; (void)SvUPGRADE(error, SVt_PV); if (SvPOK(error) && SvCUR(error)) diff --git a/t/op/ref.t b/t/op/ref.t index ae3eef7..b29dcb7 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); } -print "1..66\n"; +print "1..67\n"; require 'test.pl'; @@ -346,6 +346,10 @@ runperl(prog => 'sub UNIVERSAL::AUTOLOAD { qr// } a->p' ); if ($? != 0) { print "not " }; print "ok ",++$test," - UNIVERSAL::AUTOLOAD called when freeing qr//\n"; +runperl(prog => 'sub UNIVERSAL::DESTROY { warn } bless \$a, A', stderr => 1); +if ($? != 0) { print "not " }; +print "ok ",++$test," - warn called inside UNIVERSAL::DESTROY\n"; + # test global destruction ++$test; diff --git a/util.c b/util.c index a1eb391..5e63d11 100644 --- a/util.c +++ b/util.c @@ -1247,7 +1247,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) } /* if STDERR is tied, use it instead */ - if (PL_stderrgv && (io = GvIOp(PL_stderrgv)) + if (PL_stderrgv && SvREFCNT(PL_stderrgv) && (io = GvIO(PL_stderrgv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { dSP; ENTER; PUSHMARK(SP); -- 2.7.4