Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
7766f137 |
3 | # tests for both real and emulated fork() |
8d063cd8 |
4 | |
774d564b |
5 | BEGIN { |
6 | chdir 't' if -d 't'; |
93430cb4 |
7 | unshift @INC, '../lib'; |
774d564b |
8 | require Config; import Config; |
7766f137 |
9 | unless ($Config{'d_fork'} || $Config{ccflags} =~ /-DUSE_ITHREADS\b/) { |
45c0de28 |
10 | print "1..0 # Skip: no fork\n"; |
774d564b |
11 | exit 0; |
12 | } |
7766f137 |
13 | $ENV{PERL5LIB} = "../lib"; |
774d564b |
14 | } |
15 | |
7766f137 |
16 | $|=1; |
17 | |
18 | undef $/; |
19 | @prgs = split "\n########\n", <DATA>; |
20 | print "1..", scalar @prgs, "\n"; |
21 | |
22 | $tmpfile = "forktmp000"; |
23 | 1 while -f ++$tmpfile; |
24 | END { unlink $tmpfile if $tmpfile; } |
25 | |
26 | $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); |
8d063cd8 |
27 | |
7766f137 |
28 | for (@prgs){ |
29 | my $switch; |
30 | if (s/^\s*(-\w.*)//){ |
31 | $switch = $1; |
32 | } |
33 | my($prog,$expected) = split(/\nEXPECT\n/, $_); |
34 | $expected =~ s/\n+$//; |
35 | # results can be in any order, so sort 'em |
36 | my @expected = sort split /\n/, $expected; |
37 | open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!"; |
38 | print TEST $prog, "\n"; |
39 | close TEST or die "Cannot close $tmpfile: $!"; |
40 | my $results; |
41 | if ($^O eq 'MSWin32') { |
42 | $results = `.\\perl -I../lib $switch $tmpfile 2>&1`; |
43 | } |
44 | else { |
45 | $results = `./perl $switch $tmpfile 2>&1`; |
46 | } |
47 | $status = $?; |
48 | $results =~ s/\n+$//; |
49 | $results =~ s/at\s+forktmp\d+\s+line/at - line/g; |
50 | $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g; |
51 | # bison says 'parse error' instead of 'syntax error', |
52 | # various yaccs may or may not capitalize 'syntax'. |
53 | $results =~ s/^(syntax|parse) error/syntax error/mig; |
54 | my @results = sort split /\n/, $results; |
55 | if ( "@results" ne "@expected" ) { |
56 | print STDERR "PROG: $switch\n$prog\n"; |
57 | print STDERR "EXPECTED:\n$expected\n"; |
58 | print STDERR "GOT:\n$results\n"; |
59 | print "not "; |
60 | } |
61 | print "ok ", ++$i, "\n"; |
62 | } |
63 | |
64 | __END__ |
65 | $| = 1; |
8d063cd8 |
66 | if ($cid = fork) { |
7766f137 |
67 | sleep 1; |
68 | if ($result = (kill 9, $cid)) { |
69 | print "ok 2\n"; |
70 | } |
71 | else { |
72 | print "not ok 2 $result\n"; |
73 | } |
74 | sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug |
8d063cd8 |
75 | } |
76 | else { |
8d063cd8 |
77 | print "ok 1\n"; |
78 | sleep 10; |
79 | } |
7766f137 |
80 | EXPECT |
81 | ok 1 |
82 | ok 2 |
83 | ######## |
84 | $| = 1; |
85 | sub forkit { |
86 | print "iteration $i start\n"; |
87 | my $x = fork; |
88 | if (defined $x) { |
89 | if ($x) { |
90 | print "iteration $i parent\n"; |
91 | } |
92 | else { |
93 | print "iteration $i child\n"; |
94 | } |
95 | } |
96 | else { |
97 | print "pid $$ failed to fork\n"; |
98 | } |
99 | } |
100 | while ($i++ < 3) { do { forkit(); }; } |
101 | EXPECT |
102 | iteration 1 start |
103 | iteration 1 parent |
104 | iteration 1 child |
105 | iteration 2 start |
106 | iteration 2 parent |
107 | iteration 2 child |
108 | iteration 2 start |
109 | iteration 2 parent |
110 | iteration 2 child |
111 | iteration 3 start |
112 | iteration 3 parent |
113 | iteration 3 child |
114 | iteration 3 start |
115 | iteration 3 parent |
116 | iteration 3 child |
117 | iteration 3 start |
118 | iteration 3 parent |
119 | iteration 3 child |
120 | iteration 3 start |
121 | iteration 3 parent |
122 | iteration 3 child |
123 | ######## |
124 | $| = 1; |
125 | fork() |
126 | ? (print("parent\n"),sleep(1)) |
127 | : (print("child\n"),exit) ; |
128 | EXPECT |
129 | parent |
130 | child |
131 | ######## |
132 | $| = 1; |
133 | fork() |
134 | ? (print("parent\n"),exit) |
135 | : (print("child\n"),sleep(1)) ; |
136 | EXPECT |
137 | parent |
138 | child |
139 | ######## |
140 | $| = 1; |
141 | @a = (1..3); |
142 | for (@a) { |
143 | if (fork) { |
144 | print "parent $_\n"; |
145 | $_ = "[$_]"; |
146 | } |
147 | else { |
148 | print "child $_\n"; |
149 | $_ = "-$_-"; |
150 | } |
151 | } |
152 | print "@a\n"; |
153 | EXPECT |
154 | parent 1 |
155 | child 1 |
156 | parent 2 |
157 | child 2 |
158 | parent 2 |
159 | child 2 |
160 | parent 3 |
161 | child 3 |
162 | parent 3 |
163 | child 3 |
164 | parent 3 |
165 | child 3 |
166 | parent 3 |
167 | child 3 |
168 | [1] [2] [3] |
169 | -1- [2] [3] |
170 | [1] -2- [3] |
171 | [1] [2] -3- |
172 | -1- -2- [3] |
173 | -1- [2] -3- |
174 | [1] -2- -3- |
175 | -1- -2- -3- |
176 | ######## |
177 | use Config; |
178 | $| = 1; |
179 | $\ = "\n"; |
180 | fork() |
181 | ? print($Config{osname} eq $^O) |
182 | : print($Config{osname} eq $^O) ; |
183 | EXPECT |
184 | 1 |
185 | 1 |
186 | ######## |
187 | $| = 1; |
188 | $\ = "\n"; |
189 | fork() |
190 | ? do { require Config; print($Config::Config{osname} eq $^O); } |
191 | : do { require Config; print($Config::Config{osname} eq $^O); } |
192 | EXPECT |
193 | 1 |
194 | 1 |
195 | ######## |
196 | $| = 1; |
197 | use Cwd; |
198 | $\ = "\n"; |
199 | my $dir; |
200 | if (fork) { |
201 | $dir = "f$$.tst"; |
202 | mkdir $dir, 0755; |
203 | chdir $dir; |
204 | print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent"; |
205 | chdir ".."; |
206 | rmdir $dir; |
207 | } |
208 | else { |
209 | sleep 2; |
210 | $dir = "f$$.tst"; |
211 | mkdir $dir, 0755; |
212 | chdir $dir; |
213 | print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child"; |
214 | chdir ".."; |
215 | rmdir $dir; |
216 | } |
217 | EXPECT |
218 | ok 1 parent |
219 | ok 1 child |
220 | ######## |
221 | $| = 1; |
222 | $\ = "\n"; |
223 | my $getenv; |
224 | if ($^O eq 'MSWin32') { |
225 | $getenv = qq[$^X -e "print \$ENV{TST}"]; |
226 | } |
227 | else { |
228 | $getenv = qq[$^X -e 'print \$ENV{TST}']; |
229 | } |
230 | if (fork) { |
231 | sleep 1; |
232 | $ENV{TST} = 'foo'; |
233 | print "parent: " . `$getenv`; |
234 | } |
235 | else { |
236 | $ENV{TST} = 'bar'; |
237 | print "child: " . `$getenv`; |
238 | sleep 1; |
239 | } |
240 | EXPECT |
241 | parent: foo |
242 | child: bar |
243 | ######## |
244 | $| = 1; |
245 | $\ = "\n"; |
246 | if ($pid = fork) { |
247 | waitpid($pid,0); |
248 | print "parent got $?" |
249 | } |
250 | else { |
251 | exit(42); |
252 | } |
253 | EXPECT |
254 | parent got 10752 |
255 | ######## |
256 | $| = 1; |
257 | $\ = "\n"; |
258 | my $echo = 'echo'; |
259 | if ($pid = fork) { |
260 | waitpid($pid,0); |
261 | print "parent got $?" |
262 | } |
263 | else { |
264 | exec("$echo foo"); |
265 | } |
266 | EXPECT |
267 | foo |
268 | parent got 0 |
269 | ######## |
270 | if (fork) { |
271 | die "parent died"; |
272 | } |
273 | else { |
274 | die "child died"; |
275 | } |
276 | EXPECT |
277 | parent died at - line 2. |
278 | child died at - line 5. |
279 | ######## |
280 | if ($pid = fork) { |
281 | eval { die "parent died" }; |
282 | print $@; |
283 | } |
284 | else { |
285 | eval { die "child died" }; |
286 | print $@; |
287 | } |
288 | EXPECT |
289 | parent died at - line 2. |
290 | child died at - line 6. |
291 | ######## |
292 | if (eval q{$pid = fork}) { |
293 | eval q{ die "parent died" }; |
294 | print $@; |
295 | } |
296 | else { |
297 | eval q{ die "child died" }; |
298 | print $@; |
299 | } |
300 | EXPECT |
301 | parent died at (eval 2) line 1. |
302 | child died at (eval 2) line 1. |
303 | ######## |
304 | BEGIN { |
305 | $| = 1; |
306 | fork and exit; |
307 | print "inner\n"; |
308 | } |
309 | # XXX In emulated fork(), the child will not execute anything after |
310 | # the BEGIN block, due to difficulties in recreating the parse stacks |
311 | # and restarting yyparse() midstream in the child. This can potentially |
312 | # be overcome by treating what's after the BEGIN{} as a brand new parse. |
313 | #print "outer\n" |
314 | EXPECT |
315 | inner |