dispatch signals when leaving an eval

Currently PERL_ASYNC_CHECK is only called during scope exit in pp_leavetry
and pp_levaeeval. This means that if the signal handler calls die, the
eval won't catch it.

This broke Sys::AlarmCall's test suite, which was doing the equivalent of

    $SIG{ALRM} = sub { die };
    eval {
	alarm(1);
	select(undef, undef, undef, 10);
    }
    # expect the die to get caught and $@ set here.

Because the select was the last statement in the block, PERL_ASYNC_CHECK
wasn't called next until the leave_scope at the end of leavetry.
See RT #88774.

The simple fix is to add a PERL_ASYNC_CHECK at the top of
leavetry and leaveeval.

diff --git a/pp_ctl.c b/pp_ctl.c
index aabbcd3..a9072df 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4062,6 +4062,7 @@ PP(pp_leaveeval)
     I32 optype;
     SV *namesv;
 
+    PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
     namesv = cx->blk_eval.old_namesv;
@@ -4183,6 +4184,7 @@ PP(pp_leavetry)
     register PERL_CONTEXT *cx;
     I32 optype;
 
+    PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);

diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 522e3b6..29fc062 100644 (file)
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,9 +9,9 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 15;
+plan tests => 17;
 
-watchdog(10);
+watchdog(15);
 
 $SIG{ALRM} = sub {
     die "Alarm!\n";
@@ -92,3 +92,25 @@ TODO:
     } for 1..2;
     is $gotit, 0, 'Received both signals';
 }
+
+{
+    # RT #88774
+    # make sure the signal handler's called in an eval block *before*
+    # the eval is popped
+
+    $SIG{'ALRM'} = sub { die "HANDLER CALLED\n" };
+
+    eval {
+       alarm(2);
+       select(undef,undef,undef,10);
+    };
+    alarm(0);
+    is($@, "HANDLER CALLED\n", 'block eval');
+
+    eval q{
+       alarm(2);
+       select(undef,undef,undef,10);
+    };
+    alarm(0);
+    is($@, "HANDLER CALLED\n", 'string eval');
+}