This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #85104] TODO test for preserving $^E across signal handlers
authorTony Cook <tony@develop-help.com>
Mon, 26 Aug 2013 05:32:36 +0000 (15:32 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 26 Aug 2013 05:32:36 +0000 (15:32 +1000)
and tests Win32 signal emulation too

MANIFEST
t/win32/signal.t [new file with mode: 0644]

index 45601d3..37221b4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5514,6 +5514,7 @@ t/uni/variables.t         See that the rules for variable names work
 t/uni/write.t                  See if Unicode formats work
 t/win32/fs.t                   Test Win32 link for compatibility
 t/win32/runenv.t               Test if Win* perl honors its env variables
+t/win32/signal.t               Test Win32 signal emulation
 t/win32/system.t               See if system works in Win*
 t/win32/system_tests           Test runner for system.t
 t/x2p/find2perl.t              Test find2perl
diff --git a/t/win32/signal.t b/t/win32/signal.t
new file mode 100644 (file)
index 0000000..71a6e7d
--- /dev/null
@@ -0,0 +1,77 @@
+#!./perl
+# Tests for signal emulation
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+
+    # only used for skip_all, the forking confuses test.pl
+    require "./test.pl";
+}
+
+BEGIN {
+    unless ($^O =~ /^MSWin/) {
+        skip_all('windows specific test');
+    }
+}
+
+skip_all("requires compilation with PERL_IMPLICIT_SYS")
+  unless $Config{ccflags} =~/(?:\A|\s)-DPERL_IMPLICIT_SYS\b/;
+
+++$|;
+
+# manual test counting because the forks confuse test.pl
+print "1..4\n";
+
+use Config;
+
+# find a safe signal, the implementation shouldn't be doing anything
+# funky with NUMdd signals
+my ($sig) = grep /^NUM/, split ' ', $Config{sig_name};
+
+# otherwise, hope CONT is safe
+$sig ||= "CONT";
+
+SKIP:
+{
+    # perl #85104
+    use warnings;
+    my $pid = fork;
+
+    unless (defined $pid) {
+       print <<EOS;
+not ok 1 # fork failed: $!
+ok 2 # SKIP
+ok 3 # SKIP
+ok 4 # SKIP
+EOS
+        last SKIP;
+    }
+    if ($pid) {
+       print "ok 1 # pseudo-forked\n";
+       sleep 2; # give the child a chance to setup
+       kill $sig, $pid;
+       waitpid($pid, 0);
+    }
+    else {
+       my $signalled;
+       $SIG{$sig} = sub {
+           $! = 1;
+           $^E = 1000;
+           print "ok 2 # $sig signal handler called\n";
+           ++$signalled;
+       };
+       $! = 0;
+       $^E = 0;
+       # wait for the signal
+       my $count = 0;
+       while (!$signalled && ++$count < 10) {
+           sleep 1;
+       }
+       print "# signaled after $count loops\n";
+       print $! != 0 ? "not " : "", "ok 3 # \$! preserved\n";
+       print $^E != 0 ? "not " : "", "ok 4 # TODO \$^E preserved\n"
+           or print STDERR "# \$^E = ", 0+$^E, "\n";
+       exit;
+    }
+}