Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
7766f137 | 3 | # tests for both real and emulated fork() |
8d063cd8 | 4 | |
774d564b | 5 | BEGIN { |
6 | chdir 't' if -d 't'; | |
20822f61 | 7 | @INC = '../lib'; |
1c25d394 | 8 | require './test.pl'; |
95e2dc41 NC |
9 | require Config; |
10 | skip_all('no fork') | |
11 | unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork}); | |
774d564b | 12 | } |
13 | ||
7766f137 GS |
14 | $|=1; |
15 | ||
5f7e0818 | 16 | run_multiple_progs('', \*DATA); |
7766f137 | 17 | |
af2fe5eb JL |
18 | my $shell = $ENV{SHELL} || ''; |
19 | SKIP: { | |
20 | skip "This test can only be run under bash or zsh" | |
21 | unless $shell =~ m{/(?:ba|z)sh$}; | |
2cc7fc55 NC |
22 | my $probe = qx{ |
23 | $shell -c 'ulimit -u 1 2>&1 && echo good' | |
24 | }; | |
25 | chomp $probe; | |
26 | skip "Can't set ulimit -u on this system: $probe" | |
27 | unless $probe eq 'good'; | |
af2fe5eb JL |
28 | |
29 | my $out = qx{ | |
30 | $shell -c 'ulimit -u 1; exec $^X -e " | |
31 | print((() = fork) == 1 ? q[ok] : q[not ok]) | |
32 | "' | |
33 | }; | |
2ffc2ff6 TC |
34 | # perl #117141 |
35 | skip "fork() didn't fail, maybe you're running as root", 1 | |
36 | if $out eq "okok"; | |
bdb37728 | 37 | is($out, "ok", "bash/zsh-only test for 'fork' returning undef on failure"); |
af2fe5eb JL |
38 | } |
39 | ||
5f7e0818 | 40 | done_testing(); |
7766f137 GS |
41 | |
42 | __END__ | |
43 | $| = 1; | |
8d063cd8 | 44 | if ($cid = fork) { |
7766f137 GS |
45 | sleep 1; |
46 | if ($result = (kill 9, $cid)) { | |
47 | print "ok 2\n"; | |
48 | } | |
49 | else { | |
50 | print "not ok 2 $result\n"; | |
51 | } | |
52 | sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug | |
8d063cd8 LW |
53 | } |
54 | else { | |
8d063cd8 LW |
55 | print "ok 1\n"; |
56 | sleep 10; | |
57 | } | |
7766f137 | 58 | EXPECT |
5f7e0818 | 59 | OPTION random |
7766f137 GS |
60 | ok 1 |
61 | ok 2 | |
62 | ######## | |
63 | $| = 1; | |
aeecf691 JD |
64 | if ($cid = fork) { |
65 | sleep 1; | |
66 | print "not " unless kill 'INT', $cid; | |
67 | print "ok 2\n"; | |
68 | } | |
69 | else { | |
70 | # XXX On Windows the default signal handler kills the | |
71 | # XXX whole process, not just the thread (pseudo-process) | |
72 | $SIG{INT} = sub { exit }; | |
73 | print "ok 1\n"; | |
74 | sleep 5; | |
75 | die; | |
76 | } | |
77 | EXPECT | |
5f7e0818 | 78 | OPTION random |
aeecf691 JD |
79 | ok 1 |
80 | ok 2 | |
81 | ######## | |
82 | $| = 1; | |
7766f137 GS |
83 | sub forkit { |
84 | print "iteration $i start\n"; | |
85 | my $x = fork; | |
86 | if (defined $x) { | |
87 | if ($x) { | |
88 | print "iteration $i parent\n"; | |
89 | } | |
90 | else { | |
91 | print "iteration $i child\n"; | |
92 | } | |
93 | } | |
94 | else { | |
95 | print "pid $$ failed to fork\n"; | |
96 | } | |
97 | } | |
98 | while ($i++ < 3) { do { forkit(); }; } | |
99 | EXPECT | |
5f7e0818 | 100 | OPTION random |
7766f137 GS |
101 | iteration 1 start |
102 | iteration 1 parent | |
103 | iteration 1 child | |
104 | iteration 2 start | |
105 | iteration 2 parent | |
106 | iteration 2 child | |
107 | iteration 2 start | |
108 | iteration 2 parent | |
109 | iteration 2 child | |
110 | iteration 3 start | |
111 | iteration 3 parent | |
112 | iteration 3 child | |
113 | iteration 3 start | |
114 | iteration 3 parent | |
115 | iteration 3 child | |
116 | iteration 3 start | |
117 | iteration 3 parent | |
118 | iteration 3 child | |
119 | iteration 3 start | |
120 | iteration 3 parent | |
121 | iteration 3 child | |
122 | ######## | |
123 | $| = 1; | |
124 | fork() | |
125 | ? (print("parent\n"),sleep(1)) | |
126 | : (print("child\n"),exit) ; | |
127 | EXPECT | |
5f7e0818 | 128 | OPTION random |
7766f137 GS |
129 | parent |
130 | child | |
131 | ######## | |
132 | $| = 1; | |
133 | fork() | |
134 | ? (print("parent\n"),exit) | |
135 | : (print("child\n"),sleep(1)) ; | |
136 | EXPECT | |
5f7e0818 | 137 | OPTION random |
7766f137 GS |
138 | parent |
139 | child | |
140 | ######## | |
141 | $| = 1; | |
142 | @a = (1..3); | |
143 | for (@a) { | |
144 | if (fork) { | |
145 | print "parent $_\n"; | |
146 | $_ = "[$_]"; | |
147 | } | |
148 | else { | |
149 | print "child $_\n"; | |
150 | $_ = "-$_-"; | |
151 | } | |
152 | } | |
153 | print "@a\n"; | |
154 | EXPECT | |
5f7e0818 | 155 | OPTION random |
7766f137 GS |
156 | parent 1 |
157 | child 1 | |
158 | parent 2 | |
159 | child 2 | |
160 | parent 2 | |
161 | child 2 | |
162 | parent 3 | |
163 | child 3 | |
164 | parent 3 | |
165 | child 3 | |
166 | parent 3 | |
167 | child 3 | |
168 | parent 3 | |
169 | child 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 | [1] -2- -3- | |
177 | -1- -2- -3- | |
178 | ######## | |
c3564e5c GS |
179 | $| = 1; |
180 | foreach my $c (1,2,3) { | |
181 | if (fork) { | |
182 | print "parent $c\n"; | |
183 | } | |
184 | else { | |
185 | print "child $c\n"; | |
186 | exit; | |
187 | } | |
188 | } | |
189 | while (wait() != -1) { print "waited\n" } | |
190 | EXPECT | |
5f7e0818 | 191 | OPTION random |
c3564e5c GS |
192 | child 1 |
193 | child 2 | |
194 | child 3 | |
195 | parent 1 | |
196 | parent 2 | |
197 | parent 3 | |
198 | waited | |
199 | waited | |
200 | waited | |
201 | ######## | |
7766f137 GS |
202 | use Config; |
203 | $| = 1; | |
204 | $\ = "\n"; | |
205 | fork() | |
206 | ? print($Config{osname} eq $^O) | |
207 | : print($Config{osname} eq $^O) ; | |
208 | EXPECT | |
5f7e0818 | 209 | OPTION random |
7766f137 GS |
210 | 1 |
211 | 1 | |
212 | ######## | |
213 | $| = 1; | |
214 | $\ = "\n"; | |
215 | fork() | |
216 | ? do { require Config; print($Config::Config{osname} eq $^O); } | |
217 | : do { require Config; print($Config::Config{osname} eq $^O); } | |
218 | EXPECT | |
5f7e0818 | 219 | OPTION random |
7766f137 GS |
220 | 1 |
221 | 1 | |
222 | ######## | |
223 | $| = 1; | |
224 | use Cwd; | |
cf2f24a4 | 225 | my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works. |
7766f137 GS |
226 | $\ = "\n"; |
227 | my $dir; | |
228 | if (fork) { | |
229 | $dir = "f$$.tst"; | |
230 | mkdir $dir, 0755; | |
231 | chdir $dir; | |
232 | print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent"; | |
233 | chdir ".."; | |
234 | rmdir $dir; | |
235 | } | |
236 | else { | |
237 | sleep 2; | |
238 | $dir = "f$$.tst"; | |
239 | mkdir $dir, 0755; | |
240 | chdir $dir; | |
241 | print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child"; | |
242 | chdir ".."; | |
243 | rmdir $dir; | |
244 | } | |
245 | EXPECT | |
5f7e0818 | 246 | OPTION random |
7766f137 GS |
247 | ok 1 parent |
248 | ok 1 child | |
249 | ######## | |
250 | $| = 1; | |
251 | $\ = "\n"; | |
252 | my $getenv; | |
2986a63f | 253 | if ($^O eq 'MSWin32' || $^O eq 'NetWare') { |
7766f137 GS |
254 | $getenv = qq[$^X -e "print \$ENV{TST}"]; |
255 | } | |
256 | else { | |
257 | $getenv = qq[$^X -e 'print \$ENV{TST}']; | |
258 | } | |
35424068 | 259 | $ENV{TST} = 'foo'; |
7766f137 GS |
260 | if (fork) { |
261 | sleep 1; | |
35424068 GS |
262 | print "parent before: " . `$getenv`; |
263 | $ENV{TST} = 'bar'; | |
264 | print "parent after: " . `$getenv`; | |
7766f137 GS |
265 | } |
266 | else { | |
35424068 GS |
267 | print "child before: " . `$getenv`; |
268 | $ENV{TST} = 'baz'; | |
269 | print "child after: " . `$getenv`; | |
7766f137 GS |
270 | } |
271 | EXPECT | |
5f7e0818 | 272 | OPTION random |
35424068 GS |
273 | child before: foo |
274 | child after: baz | |
275 | parent before: foo | |
276 | parent after: bar | |
7766f137 GS |
277 | ######## |
278 | $| = 1; | |
279 | $\ = "\n"; | |
280 | if ($pid = fork) { | |
281 | waitpid($pid,0); | |
282 | print "parent got $?" | |
283 | } | |
284 | else { | |
285 | exit(42); | |
286 | } | |
287 | EXPECT | |
5f7e0818 | 288 | OPTION random |
7766f137 GS |
289 | parent got 10752 |
290 | ######## | |
291 | $| = 1; | |
292 | $\ = "\n"; | |
293 | my $echo = 'echo'; | |
d48f1ed2 BF |
294 | if ($^O =~ /android/) { |
295 | $echo = q{sh -c 'echo $@' -- }; | |
296 | } | |
7766f137 GS |
297 | if ($pid = fork) { |
298 | waitpid($pid,0); | |
299 | print "parent got $?" | |
300 | } | |
301 | else { | |
302 | exec("$echo foo"); | |
303 | } | |
304 | EXPECT | |
5f7e0818 | 305 | OPTION random |
7766f137 GS |
306 | foo |
307 | parent got 0 | |
308 | ######## | |
309 | if (fork) { | |
310 | die "parent died"; | |
311 | } | |
312 | else { | |
313 | die "child died"; | |
314 | } | |
315 | EXPECT | |
5f7e0818 | 316 | OPTION random |
7766f137 GS |
317 | parent died at - line 2. |
318 | child died at - line 5. | |
319 | ######## | |
320 | if ($pid = fork) { | |
321 | eval { die "parent died" }; | |
322 | print $@; | |
323 | } | |
324 | else { | |
325 | eval { die "child died" }; | |
326 | print $@; | |
327 | } | |
328 | EXPECT | |
5f7e0818 | 329 | OPTION random |
7766f137 GS |
330 | parent died at - line 2. |
331 | child died at - line 6. | |
332 | ######## | |
333 | if (eval q{$pid = fork}) { | |
334 | eval q{ die "parent died" }; | |
335 | print $@; | |
336 | } | |
337 | else { | |
338 | eval q{ die "child died" }; | |
339 | print $@; | |
340 | } | |
341 | EXPECT | |
5f7e0818 | 342 | OPTION random |
7766f137 GS |
343 | parent died at (eval 2) line 1. |
344 | child died at (eval 2) line 1. | |
345 | ######## | |
346 | BEGIN { | |
347 | $| = 1; | |
348 | fork and exit; | |
349 | print "inner\n"; | |
350 | } | |
351 | # XXX In emulated fork(), the child will not execute anything after | |
352 | # the BEGIN block, due to difficulties in recreating the parse stacks | |
353 | # and restarting yyparse() midstream in the child. This can potentially | |
354 | # be overcome by treating what's after the BEGIN{} as a brand new parse. | |
355 | #print "outer\n" | |
356 | EXPECT | |
5f7e0818 | 357 | OPTION random |
7766f137 | 358 | inner |
030866aa GS |
359 | ######## |
360 | sub pipe_to_fork ($$) { | |
361 | my $parent = shift; | |
362 | my $child = shift; | |
363 | pipe($child, $parent) or die; | |
364 | my $pid = fork(); | |
365 | die "fork() failed: $!" unless defined $pid; | |
366 | close($pid ? $child : $parent); | |
367 | $pid; | |
368 | } | |
369 | ||
370 | if (pipe_to_fork('PARENT','CHILD')) { | |
371 | # parent | |
372 | print PARENT "pipe_to_fork\n"; | |
373 | close PARENT; | |
374 | } | |
375 | else { | |
376 | # child | |
377 | while (<CHILD>) { print; } | |
378 | close CHILD; | |
379 | exit; | |
380 | } | |
381 | ||
382 | sub pipe_from_fork ($$) { | |
383 | my $parent = shift; | |
384 | my $child = shift; | |
385 | pipe($parent, $child) or die; | |
386 | my $pid = fork(); | |
387 | die "fork() failed: $!" unless defined $pid; | |
388 | close($pid ? $child : $parent); | |
389 | $pid; | |
390 | } | |
391 | ||
392 | if (pipe_from_fork('PARENT','CHILD')) { | |
393 | # parent | |
394 | while (<PARENT>) { print; } | |
395 | close PARENT; | |
396 | } | |
397 | else { | |
398 | # child | |
399 | print CHILD "pipe_from_fork\n"; | |
400 | close CHILD; | |
401 | exit; | |
402 | } | |
403 | EXPECT | |
5f7e0818 | 404 | OPTION random |
030866aa GS |
405 | pipe_from_fork |
406 | pipe_to_fork | |
68a29c53 | 407 | ######## |
10d51319 | 408 | $|=1; |
68a29c53 GS |
409 | if ($pid = fork()) { |
410 | print "forked first kid\n"; | |
411 | print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; | |
412 | } | |
413 | else { | |
414 | print "first child\n"; | |
415 | exit(0); | |
416 | } | |
417 | if ($pid = fork()) { | |
418 | print "forked second kid\n"; | |
419 | print "wait() returned ok\n" if wait() == $pid; | |
420 | } | |
421 | else { | |
422 | print "second child\n"; | |
423 | exit(0); | |
424 | } | |
425 | EXPECT | |
5f7e0818 | 426 | OPTION random |
68a29c53 GS |
427 | forked first kid |
428 | first child | |
429 | waitpid() returned ok | |
430 | forked second kid | |
431 | second child | |
432 | wait() returned ok | |
a0bd7037 SR |
433 | ######## |
434 | pipe(RDR,WTR) or die $!; | |
435 | my $pid = fork; | |
436 | die "fork: $!" if !defined $pid; | |
437 | if ($pid == 0) { | |
a0bd7037 | 438 | close RDR; |
5bf4f5b3 | 439 | print WTR "STRING_FROM_CHILD\n"; |
a0bd7037 SR |
440 | close WTR; |
441 | } else { | |
a0bd7037 | 442 | close WTR; |
5bf4f5b3 | 443 | chomp(my $string_from_child = <RDR>); |
a0bd7037 | 444 | close RDR; |
5bf4f5b3 | 445 | print $string_from_child eq "STRING_FROM_CHILD", "\n"; |
a0bd7037 SR |
446 | } |
447 | EXPECT | |
5f7e0818 | 448 | OPTION random |
a0bd7037 | 449 | 1 |
d8d97e70 DM |
450 | ######## |
451 | # [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation | |
452 | sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2); | |
453 | EXPECT | |
5f7e0818 | 454 | OPTION random |
d8d97e70 DM |
455 | 1 |
456 | 1 | |
a1f97a07 DM |
457 | ######## |
458 | # [perl #72604] @DB::args stops working across Win32 fork | |
459 | $|=1; | |
460 | sub f { | |
461 | if ($pid = fork()) { | |
462 | print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; | |
463 | } | |
464 | else { | |
465 | package DB; | |
466 | my @c = caller(0); | |
467 | print "child: called as [$c[3](", join(',',@DB::args), ")]\n"; | |
468 | exit(0); | |
469 | } | |
470 | } | |
471 | f("foo", "bar"); | |
472 | EXPECT | |
5f7e0818 | 473 | OPTION random |
a1f97a07 DM |
474 | child: called as [main::f(foo,bar)] |
475 | waitpid() returned ok | |
82e24582 JD |
476 | ######## |
477 | # Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 | |
478 | system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}"; | |
479 | print $?>>8, "\n"; | |
480 | EXPECT | |
481 | 0 | |
482 | ######## | |
483 | # Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 | |
484 | system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}"; | |
485 | print $?>>8, "\n"; | |
486 | EXPECT | |
487 | 0 | |
8a3cb9c6 JD |
488 | ######## |
489 | # Windows fork() emulation: can we still waitpid() after signalling SIGTERM? | |
490 | $|=1; | |
491 | if (my $pid = fork) { | |
492 | sleep 1; | |
493 | print "1\n"; | |
494 | kill 'TERM', $pid; | |
495 | waitpid($pid, 0); | |
496 | print "4\n"; | |
497 | } | |
498 | else { | |
499 | $SIG{TERM} = sub { print "2\n" }; | |
0457ceb8 | 500 | sleep 10; |
8a3cb9c6 JD |
501 | print "3\n"; |
502 | } | |
503 | EXPECT | |
504 | 1 | |
505 | 2 | |
506 | 3 | |
507 | 4 | |
96258673 DM |
508 | ######## |
509 | # this used to SEGV. RT # 121721 | |
510 | $|=1; | |
511 | &main; | |
512 | sub main { | |
513 | if (my $pid = fork) { | |
514 | waitpid($pid, 0); | |
515 | } | |
516 | else { | |
517 | print "foo\n"; | |
518 | } | |
519 | } | |
520 | EXPECT | |
521 | foo |