t/win32/signal.t

   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 skip_all("requires compilation with the fork emulation")
  19   unless $Config{'d_pseudofork'};
  20
  21 ++$|;
  22
  23 # manual test counting because the forks confuse test.pl
  24 print "1..4\n";
  25
  26 use Config;
  27
  28 # find a safe signal, the implementation shouldn't be doing anything
  29 # funky with NUMdd signals
  30 my ($sig) = grep /^NUM/, split ' ', $Config{sig_name};
  31
  32 # otherwise, hope CONT is safe
  33 $sig ||= "CONT";
  34
  35 SKIP:
  36 {
  37     # perl #85104
  38     use warnings;
  39     my $pid = fork;
  40
  41     unless (defined $pid) {
  42         print <<EOS;
  43 not ok 1 # fork failed: $!
  44 ok 2 # SKIP
  45 ok 3 # SKIP
  46 ok 4 # SKIP
  47 EOS
  48         last SKIP;
  49     }
  50     if ($pid) {
  51         print "ok 1 # pseudo-forked\n";
  52         sleep 2; # give the child a chance to setup
  53         kill $sig, $pid;
  54         waitpid($pid, 0);
  55     }
  56     else {
  57         my $signalled;
  58         $SIG{$sig} = sub {
  59             $! = 1;
  60             $^E = 1000;
  61             print "ok 2 # $sig signal handler called\n";
  62             ++$signalled;
  63         };
  64         $! = 0;
  65         $^E = 0;
  66         # wait for the signal
  67         my $count = 0;
  68         while (!$signalled && ++$count < 10) {
  69             sleep 1;
  70         }
  71         print "# signaled after $count loops\n";
  72         print $! != 0 ? "not " : "", "ok 3 # \$! preserved\n";
  73         print $^E != 0 ? "not " : "", "ok 4 # \$^E preserved\n"
  74             or print STDERR "# \$^E = ", 0+$^E, "\n";
  75         exit;
  76     }
  77 }