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