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

diff --git a/pp_sys.c b/pp_sys.c
index 3f1e0b7..be1675c 100644 (file)
--- 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 (executable)
--- 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 (file)
--- 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);