This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/inc.t, t/op/hexfp.t, t/op/sprintf2.t: Add missing d_ prefixes for Config variabl...
[perl5.git] / t / win32 / signal.t
CommitLineData
ed51a345
TC
1#!./perl
2# Tests for signal emulation
3
4BEGIN {
5 chdir 't' if -d 't';
6 @INC = '../lib';
7
8 # only used for skip_all, the forking confuses test.pl
9 require "./test.pl";
10}
11
12BEGIN {
13 unless ($^O =~ /^MSWin/) {
14 skip_all('windows specific test');
15 }
16}
17
544e1450
N
18use strict;
19use Config;
20
83481e45
SH
21skip_all("requires compilation with the fork emulation")
22 unless $Config{'d_pseudofork'};
ed51a345
TC
23
24++$|;
25
26# manual test counting because the forks confuse test.pl
27print "1..4\n";
28
ed51a345
TC
29# find a safe signal, the implementation shouldn't be doing anything
30# funky with NUMdd signals
31my ($sig) = grep /^NUM/, split ' ', $Config{sig_name};
32
33# otherwise, hope CONT is safe
34$sig ||= "CONT";
35
36SKIP:
37{
38 # perl #85104
39 use warnings;
40 my $pid = fork;
41
42 unless (defined $pid) {
43 print <<EOS;
44not ok 1 # fork failed: $!
45ok 2 # SKIP
46ok 3 # SKIP
47ok 4 # SKIP
48EOS
49 last SKIP;
50 }
51 if ($pid) {
52 print "ok 1 # pseudo-forked\n";
53 sleep 2; # give the child a chance to setup
54 kill $sig, $pid;
55 waitpid($pid, 0);
56 }
57 else {
58 my $signalled;
59 $SIG{$sig} = sub {
60 $! = 1;
61 $^E = 1000;
62 print "ok 2 # $sig signal handler called\n";
63 ++$signalled;
64 };
65 $! = 0;
66 $^E = 0;
67 # wait for the signal
68 my $count = 0;
69 while (!$signalled && ++$count < 10) {
70 sleep 1;
71 }
72 print "# signaled after $count loops\n";
73 print $! != 0 ? "not " : "", "ok 3 # \$! preserved\n";
6ca940a9 74 print $^E != 0 ? "not " : "", "ok 4 # \$^E preserved\n"
ed51a345
TC
75 or print STDERR "# \$^E = ", 0+$^E, "\n";
76 exit;
77 }
78}