t/io/closepid.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 if ($^O eq 'dos') {
  10     skip_all("no multitasking");
  11 }
  12
  13 plan tests => 3;
  14 watchdog(10, $^O eq 'MSWin32' ? "alarm" : '');
  15
  16 use Config;
  17 $| = 1;
  18 $SIG{PIPE} = 'IGNORE';
  19 # work around a shell set to ignore HUP
  20 $SIG{HUP} = 'DEFAULT';
  21 $SIG{HUP} = 'IGNORE' if $^O eq 'interix';
  22
  23 my $perl = which_perl();
  24
  25 my $killsig = 'HUP';
  26 $killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/;
  27
  28 SKIP:
  29 {
  30     skip("Not relevant to $^O", 3)
  31       if $^O eq "MSWin32" || $^O eq "VMS";
  32     skip("only matters for waitpid or wait4", 3)
  33       unless $Config{d_waitpid} || $Config{d_wait4};
  34     # [perl #119893]
  35     # close on the original of a popen handle dupped to a standard handle
  36     # would wait4pid(0, ...)
  37     open my $savein, "<&", \*STDIN;
  38     my $pid = open my $fh1, "-|", $perl, "-e", "sleep 50";
  39     ok($pid, "open a pipe");
  40     # at this point PL_fdpids[fileno($fh1)] is the pid of the new process
  41     ok(open(STDIN, "<&=", $fh1), "dup the pipe");
  42     # now PL_fdpids[fileno($fh1)] is zero and PL_fdpids[0] is
  43     # the pid of the process created above, previously this would block
  44     # internally on waitpid(0, ...)
  45     ok(close($fh1), "close the original");
  46     kill $killsig, $pid;
  47     open STDIN, "<&", $savein;
  48 }