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