1#!./perl
2
3# tests for both real and emulated fork()
4
5BEGIN {
6    chdir 't' if -d 't';
7    require './test.pl';
8    set_up_inc('../lib');
9    require Config;
10    skip_all('no fork')
11	unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork});
12    skip_all('no fork')
13        if $^O eq 'MSWin32' && is_miniperl();
14}
15
16$|=1;
17
18run_multiple_progs('', \*DATA);
19
20my $shell = $ENV{SHELL} || '';
21SKIP: {
22    skip "This test can only be run under bash or zsh"
23        unless $shell =~ m{/(?:ba|z)sh$};
24    my $probe = qx{
25        $shell -c 'ulimit -u 1 2>/dev/null && echo good'
26    };
27    chomp $probe;
28    skip "Can't set ulimit -u on this system: $probe"
29	unless $probe eq 'good';
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    };
36    # perl #117141
37    skip "fork() didn't fail, maybe you're running as root", 1
38      if $out eq "okok";
39    is($out, "ok", "bash/zsh-only test for 'fork' returning undef on failure");
40}
41
42done_testing();
43
44__END__
45$| = 1;
46if ($cid = fork) {
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
55}
56else {
57    print "ok 1\n";
58    sleep 10;
59}
60EXPECT
61OPTION random
62ok 1
63ok 2
64########
65$| = 1;
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
80OPTION random
81ok 1
82ok 2
83########
84$| = 1;
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
102OPTION random
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
130OPTION random
131parent
132child
133########
134$| = 1;
135fork()
136 ? (print("parent\n"),exit)
137 : (print("child\n"),sleep(1)) ;
138EXPECT
139OPTION random
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
157OPTION random
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########
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
193OPTION random
194child 1
195child 2
196child 3
197parent 1
198parent 2
199parent 3
200waited
201waited
202waited
203########
204use Config;
205$| = 1;
206$\ = "\n";
207fork()
208 ? print($Config{osname} eq $^O)
209 : print($Config{osname} eq $^O) ;
210EXPECT
211OPTION random
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
221OPTION random
2221
2231
224########
225$| = 1;
226use Cwd;
227my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works.
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
248OPTION random
249ok 1 parent
250ok 1 child
251########
252$| = 1;
253$\ = "\n";
254my $getenv;
255if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
256    $getenv = qq[$^X -e "print \$ENV{TST}"];
257}
258else {
259    $getenv = qq[$^X -e 'print \$ENV{TST}'];
260}
261$ENV{TST} = 'foo';
262if (fork) {
263    sleep 1;
264    print "parent before: " . `$getenv`;
265    $ENV{TST} = 'bar';
266    print "parent after: " . `$getenv`;
267}
268else {
269    print "child before: " . `$getenv`;
270    $ENV{TST} = 'baz';
271    print "child after: " . `$getenv`;
272}
273EXPECT
274OPTION random
275child before: foo
276child after: baz
277parent before: foo
278parent after: bar
279########
280$| = 1;
281$\ = "\n";
282if ($pid = fork) {
283    waitpid($pid,0);
284    print "parent got $?"
285}
286else {
287    exit(42);
288}
289EXPECT
290OPTION random
291parent got 10752
292########
293$| = 1;
294$\ = "\n";
295my $echo = 'echo';
296if ($^O =~ /android/) {
297    $echo = q{sh -c 'echo $@' -- };
298}
299if ($pid = fork) {
300    waitpid($pid,0);
301    print "parent got $?"
302}
303else {
304    exec("$echo foo");
305}
306EXPECT
307OPTION random
308foo
309parent got 0
310########
311if (fork) {
312    die "parent died";
313}
314else {
315    die "child died";
316}
317EXPECT
318OPTION random
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
331OPTION random
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
344OPTION random
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
359OPTION random
360inner
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
406OPTION random
407pipe_from_fork
408pipe_to_fork
409########
410$|=1;
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
428OPTION random
429forked first kid
430first child
431waitpid() returned ok
432forked second kid
433second child
434wait() returned ok
435########
436pipe(RDR,WTR) or die $!;
437my $pid = fork;
438die "fork: $!" if !defined $pid;
439if ($pid == 0) {
440    close RDR;
441    print WTR "STRING_FROM_CHILD\n";
442    close WTR;
443} else {
444    close WTR;
445    chomp(my $string_from_child  = <RDR>);
446    close RDR;
447    print $string_from_child eq "STRING_FROM_CHILD", "\n";
448}
449EXPECT
450OPTION random
4511
452########
453# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation
454sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
455EXPECT
456OPTION random
4571
4581
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
475OPTION random
476child: called as [main::f(foo,bar)]
477waitpid() returned ok
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
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" };
502    sleep 10;
503    print "3\n";
504}
505EXPECT
5061
5072
5083
5094
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
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
534