| 1 | #!./perl |
| 2 | # Tests for signal emulation |
| 3 | |
| 4 | BEGIN { |
| 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 | |
| 12 | BEGIN { |
| 13 | unless ($^O =~ /^MSWin/) { |
| 14 | skip_all('windows specific test'); |
| 15 | } |
| 16 | } |
| 17 | |
| 18 | use strict; |
| 19 | use Config; |
| 20 | |
| 21 | skip_all("requires compilation with the fork emulation") |
| 22 | unless $Config{'d_pseudofork'}; |
| 23 | |
| 24 | ++$|; |
| 25 | |
| 26 | # manual test counting because the forks confuse test.pl |
| 27 | print "1..4\n"; |
| 28 | |
| 29 | # find a safe signal, the implementation shouldn't be doing anything |
| 30 | # funky with NUMdd signals |
| 31 | my ($sig) = grep /^NUM/, split ' ', $Config{sig_name}; |
| 32 | |
| 33 | # otherwise, hope CONT is safe |
| 34 | $sig ||= "CONT"; |
| 35 | |
| 36 | SKIP: |
| 37 | { |
| 38 | # perl #85104 |
| 39 | use warnings; |
| 40 | my $pid = fork; |
| 41 | |
| 42 | unless (defined $pid) { |
| 43 | print <<EOS; |
| 44 | not ok 1 # fork failed: $! |
| 45 | ok 2 # SKIP |
| 46 | ok 3 # SKIP |
| 47 | ok 4 # SKIP |
| 48 | EOS |
| 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"; |
| 74 | print $^E != 0 ? "not " : "", "ok 4 # \$^E preserved\n" |
| 75 | or print STDERR "# \$^E = ", 0+$^E, "\n"; |
| 76 | exit; |
| 77 | } |
| 78 | } |