From ed51a345f34e4dd7c7c58241f538c01d9f58b539 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 26 Aug 2013 15:32:36 +1000
Subject: [PATCH] [perl #85104] TODO test for preserving $^E across signal
 handlers

and tests Win32 signal emulation too
---
 MANIFEST         |  1 +
 t/win32/signal.t | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+)
 create mode 100644 t/win32/signal.t

diff --git a/MANIFEST b/MANIFEST
index 45601d3..37221b4 100644
--- 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
index 0000000..71a6e7d
--- /dev/null
+++ b/t/win32/signal.t
@@ -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;
+    }
+}
-- 
2.7.4