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