Commit | Line | Data |
61f2b451 |
1 | #!./perl |
2 | |
3 | BEGIN { |
7a4c00b4 |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
93430cb4 |
6 | unshift @INC, '../lib' if -d '../lib'; |
7a4c00b4 |
7 | } |
8 | } |
9 | |
10 | use Config; |
11 | |
12 | BEGIN { |
13 | if(-d "lib" && -f "TEST") { |
45c0de28 |
14 | my $reason; |
15 | if (! $Config{'d_fork'}) { |
16 | $reason = 'no fork'; |
17 | } |
18 | elsif ($Config{'extensions'} !~ /\bIO\b/) { |
19 | $reason = 'IO extension unavailable'; |
20 | } |
21 | undef $reason if $^O eq 'VMS'; |
22 | if ($reason) { |
23 | print "1..0 # Skip: $reason\n"; |
7a4c00b4 |
24 | exit 0; |
25 | } |
61f2b451 |
26 | } |
27 | } |
28 | |
29 | use IO::Pipe; |
30 | |
774d564b |
31 | my $perl = './perl'; |
32 | |
61f2b451 |
33 | $| = 1; |
774d564b |
34 | print "1..10\n"; |
35 | |
36 | $pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"'); |
37 | while (<$pipe>) { |
38 | s/^not //; |
39 | print; |
40 | } |
41 | $pipe->close or print "# \$!=$!\nnot "; |
42 | print "ok 2\n"; |
43 | |
44 | $cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //'; |
45 | $pipe = new IO::Pipe->writer($perl, '-pe', $cmd); |
46 | print $pipe "not ok 3\n" ; |
47 | $pipe->close or print "# \$!=$!\nnot "; |
48 | print "ok 4\n"; |
61f2b451 |
49 | |
a245ea2d |
50 | # Check if can fork with dynamic extensions (bug in CRT): |
51 | if ($^O eq 'os2' and |
52 | system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { |
53 | print "ok $_ # skipped: broken fork\n" for 5..10; |
54 | exit 0; |
55 | } |
56 | |
61f2b451 |
57 | $pipe = new IO::Pipe; |
58 | |
59 | $pid = fork(); |
60 | |
61 | if($pid) |
62 | { |
63 | $pipe->writer; |
774d564b |
64 | print $pipe "Xk 5\n"; |
65 | print $pipe "oY 6\n"; |
61f2b451 |
66 | $pipe->close; |
67 | wait; |
68 | } |
69 | elsif(defined $pid) |
70 | { |
71 | $pipe->reader; |
72 | $stdin = bless \*STDIN, "IO::Handle"; |
73 | $stdin->fdopen($pipe,"r"); |
74 | exec 'tr', 'YX', 'ko'; |
75 | } |
76 | else |
77 | { |
774d564b |
78 | die "# error = $!"; |
61f2b451 |
79 | } |
80 | |
81 | $pipe = new IO::Pipe; |
82 | $pid = fork(); |
83 | |
84 | if($pid) |
85 | { |
86 | $pipe->reader; |
87 | while(<$pipe>) { |
88 | s/^not //; |
89 | print; |
90 | } |
91 | $pipe->close; |
92 | wait; |
93 | } |
94 | elsif(defined $pid) |
95 | { |
96 | $pipe->writer; |
97 | |
98 | $stdout = bless \*STDOUT, "IO::Handle"; |
99 | $stdout->fdopen($pipe,"w"); |
774d564b |
100 | print STDOUT "not ok 7\n"; |
101 | exec 'echo', 'not ok 8'; |
61f2b451 |
102 | } |
103 | else |
104 | { |
105 | die; |
106 | } |
107 | |
108 | $pipe = new IO::Pipe; |
109 | $pipe->writer; |
110 | |
111 | $SIG{'PIPE'} = 'broken_pipe'; |
112 | |
113 | sub broken_pipe { |
774d564b |
114 | print "ok 9\n"; |
61f2b451 |
115 | } |
116 | |
774d564b |
117 | print $pipe "not ok 9\n"; |
61f2b451 |
118 | $pipe->close; |
119 | |
3d57aefb |
120 | sleep 1; |
61f2b451 |
121 | |
774d564b |
122 | print "ok 10\n"; |
61f2b451 |
123 | |