1*b39c5158Smillert#! /usr/bin/perl -w 2*b39c5158Smillert 3*b39c5158Smillertuse strict; 4*b39c5158Smillertuse OS2::Process; # qw(P_SESSION P_UNRELATED P_NOWAIT); 5*b39c5158Smillert 6*b39c5158Smillertmy $pl = $0; 7*b39c5158Smillert$pl =~ s/_kid\.t$/.t/i; 8*b39c5158Smillertdie "Can't find the kid script" unless -r $pl; 9*b39c5158Smillert 10*b39c5158Smillertmy $inc = $ENV{PERL5LIB}; 11*b39c5158Smillert$inc = $ENV{PERLLIB} unless defined $inc; 12*b39c5158Smillert$inc = '' unless defined $inc; 13*b39c5158Smillert$ENV{PERL5LIB} = join ';', @INC, split /;/, $inc; 14*b39c5158Smillert 15*b39c5158Smillert# The thest in $pl modify the session too bad. We run the tests 16*b39c5158Smillert# in a different session to keep the current session cleaner 17*b39c5158Smillert 18*b39c5158Smillert# Apparently, this affects things at open() time, not at system() time 19*b39c5158Smillert$^F = 40; 20*b39c5158Smillert 21*b39c5158Smillert# These do not work... Apparently, the kid "interprets" file handles 22*b39c5158Smillert# open to CON as output to *its* CON (shortcut in the kernel via the 23*b39c5158Smillert# device flags?). 24*b39c5158Smillert 25*b39c5158Smillert#my @fh = ('<&STDIN', '>&STDOUT', '>&STDERR'); 26*b39c5158Smillert#my @nfd; 27*b39c5158Smillert#open $nfd[$_], $fh[$_] or die "Cannot remap FH" for 0..2; 28*b39c5158Smillert#my @fn = map fileno $_, @nfd; 29*b39c5158Smillert#$ENV{NEW_FD} = "@fn"; 30*b39c5158Smillert 31*b39c5158Smillertmy ($stdout_r,$stdout_w,$stderr_r,$stderr_w); 32*b39c5158Smillertpipe $stderr_r, $stderr_w or die; 33*b39c5158Smillert 34*b39c5158Smillert# Duper for $stderr_r to STDERR 35*b39c5158Smillertmy ($e_r, $e_w) = map fileno $_, $stderr_r, $stderr_w; 36*b39c5158Smillertmy $k = system P_NOWAIT, $^X, '-we', <<'EOS', $e_r, $e_w or die "Cannot start a STDERR duper"; 37*b39c5158Smillert my ($e_r, $e_w) = @ARGV; 38*b39c5158Smillert # close the other end by the implicit close: 39*b39c5158Smillert { open my $closeit, ">&=$e_w" or die "kid: open >&=$e_w: $!, `$^E'" } 40*b39c5158Smillert open IN, "<&=$e_r" or die "kid: open <&=$e_r: $!, `$^E'"; 41*b39c5158Smillert select STDERR; $| = 1; print while sysread IN, $_, 1<<16; 42*b39c5158SmillertEOS 43*b39c5158Smillertclose $stderr_r or die; # Now the kid is the owner 44*b39c5158Smillert 45*b39c5158Smillertpipe $stdout_r, $stdout_w or die; 46*b39c5158Smillert 47*b39c5158Smillertmy @fn = (map fileno $_, $stdout_w, $stderr_w); 48*b39c5158Smillert$ENV{NEW_FD} = "@fn"; 49*b39c5158Smillert# print "# fns=@fn\n"; 50*b39c5158Smillert 51*b39c5158Smillert$ENV{OS2_PROCESS_TEST_SEPARATE_SESSION} = 1; 52*b39c5158Smillertmy $pid = system P_SESSION, $^X, $pl, @ARGV or die; 53*b39c5158Smillertclose $stderr_w or die; # Leave these two FH to the kid only 54*b39c5158Smillertclose $stdout_w or die; 55*b39c5158Smillert 56*b39c5158Smillert# Duplicate the STDOUT of the kid: 57*b39c5158Smillert# These are workarounds for bug in sysread: it is reading in binary... 58*b39c5158Smillertbinmode $stdout_r; 59*b39c5158Smillertbinmode STDOUT; 60*b39c5158Smillert$| = 1; print while sysread $stdout_r, $_, 1<<16; 61*b39c5158Smillert 62*b39c5158Smillertwaitpid($pid, 0) >= 0 or die; 63*b39c5158Smillert 64*b39c5158Smillert# END { print "# parent finished\r\n" } 65