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