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