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 GS |
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 IZ |
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 |