This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/fork.t: Don't output shell warning
[perl5.git] / t / op / fork.t
CommitLineData
8d063cd8
LW
1#!./perl
2
7766f137 3# tests for both real and emulated fork()
8d063cd8 4
774d564b 5BEGIN {
6 chdir 't' if -d 't';
1c25d394 7 require './test.pl';
624c42e2 8 set_up_inc('../lib');
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 18run_multiple_progs('', \*DATA);
7766f137 19
af2fe5eb
JL
20my $shell = $ENV{SHELL} || '';
21SKIP: {
22 skip "This test can only be run under bash or zsh"
23 unless $shell =~ m{/(?:ba|z)sh$};
2cc7fc55 24 my $probe = qx{
06b22f95 25 $shell -c 'ulimit -u 1 2>/dev/null && echo good'
2cc7fc55
NC
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 42done_testing();
7766f137
GS
43
44__END__
45$| = 1;
8d063cd8 46if ($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}
56else {
8d063cd8
LW
57 print "ok 1\n";
58 sleep 10;
59}
7766f137 60EXPECT
5f7e0818 61OPTION random
7766f137
GS
62ok 1
63ok 2
64########
65$| = 1;
aeecf691
JD
66if ($cid = fork) {
67 sleep 1;
68 print "not " unless kill 'INT', $cid;
69 print "ok 2\n";
70}
71else {
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}
79EXPECT
5f7e0818 80OPTION random
aeecf691
JD
81ok 1
82ok 2
83########
84$| = 1;
7766f137
GS
85sub 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}
100while ($i++ < 3) { do { forkit(); }; }
101EXPECT
5f7e0818 102OPTION random
7766f137
GS
103iteration 1 start
104iteration 1 parent
105iteration 1 child
106iteration 2 start
107iteration 2 parent
108iteration 2 child
109iteration 2 start
110iteration 2 parent
111iteration 2 child
112iteration 3 start
113iteration 3 parent
114iteration 3 child
115iteration 3 start
116iteration 3 parent
117iteration 3 child
118iteration 3 start
119iteration 3 parent
120iteration 3 child
121iteration 3 start
122iteration 3 parent
123iteration 3 child
124########
125$| = 1;
126fork()
127 ? (print("parent\n"),sleep(1))
128 : (print("child\n"),exit) ;
129EXPECT
5f7e0818 130OPTION random
7766f137
GS
131parent
132child
133########
134$| = 1;
135fork()
136 ? (print("parent\n"),exit)
137 : (print("child\n"),sleep(1)) ;
138EXPECT
5f7e0818 139OPTION random
7766f137
GS
140parent
141child
142########
143$| = 1;
144@a = (1..3);
145for (@a) {
146 if (fork) {
147 print "parent $_\n";
148 $_ = "[$_]";
149 }
150 else {
151 print "child $_\n";
152 $_ = "-$_-";
153 }
154}
155print "@a\n";
156EXPECT
5f7e0818 157OPTION random
7766f137
GS
158parent 1
159child 1
160parent 2
161child 2
162parent 2
163child 2
164parent 3
165child 3
166parent 3
167child 3
168parent 3
169child 3
170parent 3
171child 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;
182foreach 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}
191while (wait() != -1) { print "waited\n" }
192EXPECT
5f7e0818 193OPTION random
c3564e5c
GS
194child 1
195child 2
196child 3
197parent 1
198parent 2
199parent 3
200waited
201waited
202waited
203########
7766f137
GS
204use Config;
205$| = 1;
206$\ = "\n";
207fork()
208 ? print($Config{osname} eq $^O)
209 : print($Config{osname} eq $^O) ;
210EXPECT
5f7e0818 211OPTION random
7766f137
GS
2121
2131
214########
215$| = 1;
216$\ = "\n";
217fork()
218 ? do { require Config; print($Config::Config{osname} eq $^O); }
219 : do { require Config; print($Config::Config{osname} eq $^O); }
220EXPECT
5f7e0818 221OPTION random
7766f137
GS
2221
2231
224########
225$| = 1;
226use Cwd;
cf2f24a4 227my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works.
7766f137
GS
228$\ = "\n";
229my $dir;
230if (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}
238else {
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}
247EXPECT
5f7e0818 248OPTION random
7766f137
GS
249ok 1 parent
250ok 1 child
251########
252$| = 1;
253$\ = "\n";
254my $getenv;
2986a63f 255if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
7766f137
GS
256 $getenv = qq[$^X -e "print \$ENV{TST}"];
257}
258else {
259 $getenv = qq[$^X -e 'print \$ENV{TST}'];
260}
35424068 261$ENV{TST} = 'foo';
7766f137
GS
262if (fork) {
263 sleep 1;
35424068
GS
264 print "parent before: " . `$getenv`;
265 $ENV{TST} = 'bar';
266 print "parent after: " . `$getenv`;
7766f137
GS
267}
268else {
35424068
GS
269 print "child before: " . `$getenv`;
270 $ENV{TST} = 'baz';
271 print "child after: " . `$getenv`;
7766f137
GS
272}
273EXPECT
5f7e0818 274OPTION random
35424068
GS
275child before: foo
276child after: baz
277parent before: foo
278parent after: bar
7766f137
GS
279########
280$| = 1;
281$\ = "\n";
282if ($pid = fork) {
283 waitpid($pid,0);
284 print "parent got $?"
285}
286else {
287 exit(42);
288}
289EXPECT
5f7e0818 290OPTION random
7766f137
GS
291parent got 10752
292########
293$| = 1;
294$\ = "\n";
295my $echo = 'echo';
d48f1ed2
BF
296if ($^O =~ /android/) {
297 $echo = q{sh -c 'echo $@' -- };
298}
7766f137
GS
299if ($pid = fork) {
300 waitpid($pid,0);
301 print "parent got $?"
302}
303else {
304 exec("$echo foo");
305}
306EXPECT
5f7e0818 307OPTION random
7766f137
GS
308foo
309parent got 0
310########
311if (fork) {
312 die "parent died";
313}
314else {
315 die "child died";
316}
317EXPECT
5f7e0818 318OPTION random
7766f137
GS
319parent died at - line 2.
320child died at - line 5.
321########
322if ($pid = fork) {
323 eval { die "parent died" };
324 print $@;
325}
326else {
327 eval { die "child died" };
328 print $@;
329}
330EXPECT
5f7e0818 331OPTION random
7766f137
GS
332parent died at - line 2.
333child died at - line 6.
334########
335if (eval q{$pid = fork}) {
336 eval q{ die "parent died" };
337 print $@;
338}
339else {
340 eval q{ die "child died" };
341 print $@;
342}
343EXPECT
5f7e0818 344OPTION random
7766f137
GS
345parent died at (eval 2) line 1.
346child died at (eval 2) line 1.
347########
348BEGIN {
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"
358EXPECT
5f7e0818 359OPTION random
7766f137 360inner
030866aa
GS
361########
362sub 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
372if (pipe_to_fork('PARENT','CHILD')) {
373 # parent
374 print PARENT "pipe_to_fork\n";
375 close PARENT;
376}
377else {
378 # child
379 while (<CHILD>) { print; }
380 close CHILD;
381 exit;
382}
383
384sub 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
394if (pipe_from_fork('PARENT','CHILD')) {
395 # parent
396 while (<PARENT>) { print; }
397 close PARENT;
398}
399else {
400 # child
401 print CHILD "pipe_from_fork\n";
402 close CHILD;
403 exit;
404}
405EXPECT
5f7e0818 406OPTION random
030866aa
GS
407pipe_from_fork
408pipe_to_fork
68a29c53 409########
10d51319 410$|=1;
68a29c53
GS
411if ($pid = fork()) {
412 print "forked first kid\n";
413 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
414}
415else {
416 print "first child\n";
417 exit(0);
418}
419if ($pid = fork()) {
420 print "forked second kid\n";
421 print "wait() returned ok\n" if wait() == $pid;
422}
423else {
424 print "second child\n";
425 exit(0);
426}
427EXPECT
5f7e0818 428OPTION random
68a29c53
GS
429forked first kid
430first child
431waitpid() returned ok
432forked second kid
433second child
434wait() returned ok
a0bd7037
SR
435########
436pipe(RDR,WTR) or die $!;
437my $pid = fork;
438die "fork: $!" if !defined $pid;
439if ($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}
449EXPECT
5f7e0818 450OPTION random
a0bd7037 4511
d8d97e70
DM
452########
453# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation
454sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
455EXPECT
5f7e0818 456OPTION random
d8d97e70
DM
4571
4581
a1f97a07
DM
459########
460# [perl #72604] @DB::args stops working across Win32 fork
461$|=1;
462sub 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}
473f("foo", "bar");
474EXPECT
5f7e0818 475OPTION random
a1f97a07
DM
476child: called as [main::f(foo,bar)]
477waitpid() returned ok
82e24582
JD
478########
479# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
480system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}";
481print $?>>8, "\n";
482EXPECT
4830
484########
485# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
486system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}";
487print $?>>8, "\n";
488EXPECT
4890
8a3cb9c6
JD
490########
491# Windows fork() emulation: can we still waitpid() after signalling SIGTERM?
492$|=1;
493if (my $pid = fork) {
494 sleep 1;
495 print "1\n";
496 kill 'TERM', $pid;
497 waitpid($pid, 0);
498 print "4\n";
499}
500else {
501 $SIG{TERM} = sub { print "2\n" };
0457ceb8 502 sleep 10;
8a3cb9c6
JD
503 print "3\n";
504}
505EXPECT
5061
5072
5083
5094
96258673
DM
510########
511# this used to SEGV. RT # 121721
512$|=1;
513&main;
514sub main {
515 if (my $pid = fork) {
516 waitpid($pid, 0);
517 }
518 else {
519 print "foo\n";
520 }
521}
522EXPECT
523foo
49f9fecb
VP
524########
525# ${^GLOBAL_PHASE} at the end of a pseudo-fork
526if (my $pid = fork) {
527 waitpid $pid, 0;
528} else {
529 eval 'END { print "${^GLOBAL_PHASE}\n" }';
530 exit;
531}
532EXPECT
533END