don't let arriving signals reset $@ [perl #45173]

since signals can arrive at any point, clearing $@ isn't a safe
thing to do

diff --git a/mg.c b/mg.c
index 8cfee10..14965da 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -3111,6 +3111,7 @@ Perl_sighandler(int sig)
     U32 flags = 0;
     XPV * const tXpv = PL_Xpv;
     I32 old_ss_ix = PL_savestack_ix;
+    SV *errsv_save = NULL;
 
 
     if (!PL_psig_ptr[sig]) {
@@ -3189,10 +3190,13 @@ Perl_sighandler(int sig)
 #endif
     PUTBACK;
 
+    errsv_save = newSVsv(ERRSV);
+
     call_sv(MUTABLE_SV(cv), G_DISCARD|G_EVAL);
 
     POPSTACK;
     if (SvTRUE(ERRSV)) {
+        SvREFCNT_dec(errsv_save);
 #ifndef PERL_MICRO
        /* Handler "died", for example to get out of a restart-able read().
         * Before we re-do that on its behalf re-enable the signal which was
@@ -3216,6 +3220,11 @@ Perl_sighandler(int sig)
 #endif /* !PERL_MICRO */
        die_sv(ERRSV);
     }
+    else {
+        sv_setsv(ERRSV, errsv_save);
+        SvREFCNT_dec(errsv_save);
+    }
+
 cleanup:
     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;

diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 8161a71..13303fd 100644 (file)
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 26;
+plan tests => 29;
 
 watchdog(15);
 
@@ -147,3 +147,14 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
     $SIG{"KILL\0"} = sub { 1 };
     like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
 }
+
+# [perl #45173]
+{
+    my $hup_called;
+    local $SIG{HUP} = sub { $hup_called = 1 };
+    $@ = "died";
+    is($@, "died");
+    kill 'HUP', $$;
+    is($hup_called, 1);
+    is($@, "died");
+}