dispatch signals when leaving an eval

[perl5.git] / t / op / sigdispatch.t

diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index e3c8fdb..29fc062 100644 (file)
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,9 +9,9 @@ BEGIN {
 use strict;
 use Config;
 
 use strict;
 use Config;
 

-plan tests => 12;
+plan tests => 17;

 
 

-watchdog(10);
+watchdog(15);

 
 $SIG{ALRM} = sub {
     die "Alarm!\n";
 
 $SIG{ALRM} = sub {
     die "Alarm!\n";


@@ -39,7 +39,8 @@ eval {
 is($@, "Alarm!\n", 'after the second loop');
 
 SKIP: {
 is($@, "Alarm!\n", 'after the second loop');
 
 SKIP: {

-    skip('We can\'t test blocking without sigprocmask', 8) if $ENV{PERL_CORE_MINITEST} || !$Config{d_sigprocmask};
+    skip('We can\'t test blocking without sigprocmask', 11)
+       if is_miniperl() || !$Config{d_sigprocmask};

 
     require POSIX;
     my $new = POSIX::SigSet->new(&POSIX::SIGUSR1);
 
     require POSIX;
     my $new = POSIX::SigSet->new(&POSIX::SIGUSR1);


@@ -62,12 +63,54 @@ SKIP: {
                eval { POSIX::sigsuspend(POSIX::SigSet->new) };
                is $@, "FAIL\n", 'Exception is thrown, so received fourth signal';
                POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);
                eval { POSIX::sigsuspend(POSIX::SigSet->new) };
                is $@, "FAIL\n", 'Exception is thrown, so received fourth signal';
                POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $old);

+TODO:
+           {
+               local $::TODO = "Needs investigation" if $^O eq 'VMS';

                ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked';
                ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 is still blocked';

+           }

        }
 
        }
 

-    kill SIGUSR1, $$;
-    is $gotit, 1, 'Haven\'t received fifth signal yet';
-    POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old);
-    ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked';
+TODO:
+    {
+       local $::TODO = "Needs investigation" if $^O eq 'VMS';
+       kill SIGUSR1, $$;
+       is $gotit, 1, 'Haven\'t received fifth signal yet';
+       POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old);
+       ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked';
+    }

     is $gotit, 2, 'Received fifth signal';
     is $gotit, 2, 'Received fifth signal';

+
+    # test unsafe signal handlers in combination with exceptions
+    my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0);
+    POSIX::sigaction(&POSIX::SIGALRM, $action);
+    eval {
+        alarm 1;
+        my $set = POSIX::SigSet->new;
+        POSIX::sigprocmask(&POSIX::SIG_BLOCK, undef, $set);
+        is $set->ismember(&POSIX::SIGALRM), 0, "SIGALRM is not blocked on attempt $_";
+        POSIX::sigsuspend($set);
+    } 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');

 }
 }