This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Dispatch signals in infinite loops such as 1 while 1;
authorNicholas Clark <nick@ccl4.org>
Sat, 17 Apr 2010 20:24:21 +0000 (21:24 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 17 Apr 2010 20:24:21 +0000 (21:24 +0100)
With the move of PERL_ASYNC_CHECK() out from the runloop to control ops,
infinite loops became truely infinite, as their optree has no control ops.
Hence add a PERL_ASYNC_CHECK() to pp_unstack to ensure signals will be
dispatched.

Bug noticed by Jerry Hedden.

MANIFEST
pp_hot.c
t/op/sigdispatch.t [new file with mode: 0755]

index eae0fff..5ca4f13 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4471,6 +4471,7 @@ t/op/reset.t                      See if reset operator works
 t/op/reverse.t                 See if reverse operator works
 t/op/runlevel.t                        See if die() works from perl_call_*()
 t/op/setpgrpstack.t            See if setpgrp works
+t/op/sigdispatch.t             See if signals are always dispatched
 t/op/sleep.t                   See if sleep works
 t/op/smartmatch.t              See if the ~~ operator works
 t/op/sort.t                    See if sort works
index 6224f3d..e1b1e8c 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -216,6 +216,7 @@ PP(pp_unstack)
 {
     dVAR;
     I32 oldsave;
+    PERL_ASYNC_CHECK();
     TAINT_NOT;         /* Each statement is presumed innocent */
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
new file mode 100755 (executable)
index 0000000..5d9908e
--- /dev/null
@@ -0,0 +1,38 @@
+#!perl -w
+
+# We assume that TestInit has been used.
+
+BEGIN {
+      require './test.pl';
+}
+
+use strict;
+
+plan tests => 4;
+
+watchdog(10);
+
+$SIG{ALRM} = sub {
+    die "Alarm!\n";
+};
+
+pass('before the first loop');
+
+alarm 2;
+
+eval {
+    1 while 1;
+};
+
+is($@, "Alarm!\n", 'after the first loop');
+
+pass('before the second loop');
+
+alarm 2;
+
+eval {
+    while (1) {
+    }
+};
+
+is($@, "Alarm!\n", 'after the second loop');