1#!./perl 2 3# tests for both real and emulated fork() 4 5BEGIN { 6 chdir 't' if -d 't'; 7 @INC = '../lib'; 8 require './test.pl'; 9 require Config; 10 skip_all('no fork') 11 unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork}); 12} 13 14$|=1; 15 16run_multiple_progs('', \*DATA); 17 18my $shell = $ENV{SHELL} || ''; 19SKIP: { 20 skip "This test can only be run under bash or zsh" 21 unless $shell =~ m{/(?:ba|z)sh$}; 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'; 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 }; 34 # perl #117141 35 skip "fork() didn't fail, maybe you're running as root", 1 36 if $out eq "okok"; 37 is($out, "ok", "bash/zsh-only test for 'fork' returning undef on failure"); 38} 39 40done_testing(); 41 42__END__ 43$| = 1; 44if ($cid = fork) { 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 53} 54else { 55 print "ok 1\n"; 56 sleep 10; 57} 58EXPECT 59OPTION random 60ok 1 61ok 2 62######## 63$| = 1; 64if ($cid = fork) { 65 sleep 1; 66 print "not " unless kill 'INT', $cid; 67 print "ok 2\n"; 68} 69else { 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} 77EXPECT 78OPTION random 79ok 1 80ok 2 81######## 82$| = 1; 83sub 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} 98while ($i++ < 3) { do { forkit(); }; } 99EXPECT 100OPTION random 101iteration 1 start 102iteration 1 parent 103iteration 1 child 104iteration 2 start 105iteration 2 parent 106iteration 2 child 107iteration 2 start 108iteration 2 parent 109iteration 2 child 110iteration 3 start 111iteration 3 parent 112iteration 3 child 113iteration 3 start 114iteration 3 parent 115iteration 3 child 116iteration 3 start 117iteration 3 parent 118iteration 3 child 119iteration 3 start 120iteration 3 parent 121iteration 3 child 122######## 123$| = 1; 124fork() 125 ? (print("parent\n"),sleep(1)) 126 : (print("child\n"),exit) ; 127EXPECT 128OPTION random 129parent 130child 131######## 132$| = 1; 133fork() 134 ? (print("parent\n"),exit) 135 : (print("child\n"),sleep(1)) ; 136EXPECT 137OPTION random 138parent 139child 140######## 141$| = 1; 142@a = (1..3); 143for (@a) { 144 if (fork) { 145 print "parent $_\n"; 146 $_ = "[$_]"; 147 } 148 else { 149 print "child $_\n"; 150 $_ = "-$_-"; 151 } 152} 153print "@a\n"; 154EXPECT 155OPTION random 156parent 1 157child 1 158parent 2 159child 2 160parent 2 161child 2 162parent 3 163child 3 164parent 3 165child 3 166parent 3 167child 3 168parent 3 169child 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######## 179$| = 1; 180foreach 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} 189while (wait() != -1) { print "waited\n" } 190EXPECT 191OPTION random 192child 1 193child 2 194child 3 195parent 1 196parent 2 197parent 3 198waited 199waited 200waited 201######## 202use Config; 203$| = 1; 204$\ = "\n"; 205fork() 206 ? print($Config{osname} eq $^O) 207 : print($Config{osname} eq $^O) ; 208EXPECT 209OPTION random 2101 2111 212######## 213$| = 1; 214$\ = "\n"; 215fork() 216 ? do { require Config; print($Config::Config{osname} eq $^O); } 217 : do { require Config; print($Config::Config{osname} eq $^O); } 218EXPECT 219OPTION random 2201 2211 222######## 223$| = 1; 224use Cwd; 225my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works. 226$\ = "\n"; 227my $dir; 228if (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} 236else { 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} 245EXPECT 246OPTION random 247ok 1 parent 248ok 1 child 249######## 250$| = 1; 251$\ = "\n"; 252my $getenv; 253if ($^O eq 'MSWin32' || $^O eq 'NetWare') { 254 $getenv = qq[$^X -e "print \$ENV{TST}"]; 255} 256else { 257 $getenv = qq[$^X -e 'print \$ENV{TST}']; 258} 259$ENV{TST} = 'foo'; 260if (fork) { 261 sleep 1; 262 print "parent before: " . `$getenv`; 263 $ENV{TST} = 'bar'; 264 print "parent after: " . `$getenv`; 265} 266else { 267 print "child before: " . `$getenv`; 268 $ENV{TST} = 'baz'; 269 print "child after: " . `$getenv`; 270} 271EXPECT 272OPTION random 273child before: foo 274child after: baz 275parent before: foo 276parent after: bar 277######## 278$| = 1; 279$\ = "\n"; 280if ($pid = fork) { 281 waitpid($pid,0); 282 print "parent got $?" 283} 284else { 285 exit(42); 286} 287EXPECT 288OPTION random 289parent got 10752 290######## 291$| = 1; 292$\ = "\n"; 293my $echo = 'echo'; 294if ($^O =~ /android/) { 295 $echo = q{sh -c 'echo $@' -- }; 296} 297if ($pid = fork) { 298 waitpid($pid,0); 299 print "parent got $?" 300} 301else { 302 exec("$echo foo"); 303} 304EXPECT 305OPTION random 306foo 307parent got 0 308######## 309if (fork) { 310 die "parent died"; 311} 312else { 313 die "child died"; 314} 315EXPECT 316OPTION random 317parent died at - line 2. 318child died at - line 5. 319######## 320if ($pid = fork) { 321 eval { die "parent died" }; 322 print $@; 323} 324else { 325 eval { die "child died" }; 326 print $@; 327} 328EXPECT 329OPTION random 330parent died at - line 2. 331child died at - line 6. 332######## 333if (eval q{$pid = fork}) { 334 eval q{ die "parent died" }; 335 print $@; 336} 337else { 338 eval q{ die "child died" }; 339 print $@; 340} 341EXPECT 342OPTION random 343parent died at (eval 2) line 1. 344child died at (eval 2) line 1. 345######## 346BEGIN { 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" 356EXPECT 357OPTION random 358inner 359######## 360sub 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 370if (pipe_to_fork('PARENT','CHILD')) { 371 # parent 372 print PARENT "pipe_to_fork\n"; 373 close PARENT; 374} 375else { 376 # child 377 while (<CHILD>) { print; } 378 close CHILD; 379 exit; 380} 381 382sub 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 392if (pipe_from_fork('PARENT','CHILD')) { 393 # parent 394 while (<PARENT>) { print; } 395 close PARENT; 396} 397else { 398 # child 399 print CHILD "pipe_from_fork\n"; 400 close CHILD; 401 exit; 402} 403EXPECT 404OPTION random 405pipe_from_fork 406pipe_to_fork 407######## 408$|=1; 409if ($pid = fork()) { 410 print "forked first kid\n"; 411 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; 412} 413else { 414 print "first child\n"; 415 exit(0); 416} 417if ($pid = fork()) { 418 print "forked second kid\n"; 419 print "wait() returned ok\n" if wait() == $pid; 420} 421else { 422 print "second child\n"; 423 exit(0); 424} 425EXPECT 426OPTION random 427forked first kid 428first child 429waitpid() returned ok 430forked second kid 431second child 432wait() returned ok 433######## 434pipe(RDR,WTR) or die $!; 435my $pid = fork; 436die "fork: $!" if !defined $pid; 437if ($pid == 0) { 438 close RDR; 439 print WTR "STRING_FROM_CHILD\n"; 440 close WTR; 441} else { 442 close WTR; 443 chomp(my $string_from_child = <RDR>); 444 close RDR; 445 print $string_from_child eq "STRING_FROM_CHILD", "\n"; 446} 447EXPECT 448OPTION random 4491 450######## 451# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation 452sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2); 453EXPECT 454OPTION random 4551 4561 457######## 458# [perl #72604] @DB::args stops working across Win32 fork 459$|=1; 460sub 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} 471f("foo", "bar"); 472EXPECT 473OPTION random 474child: called as [main::f(foo,bar)] 475waitpid() returned ok 476######## 477# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 478system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}"; 479print $?>>8, "\n"; 480EXPECT 4810 482######## 483# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 484system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}"; 485print $?>>8, "\n"; 486EXPECT 4870 488######## 489# Windows fork() emulation: can we still waitpid() after signalling SIGTERM? 490$|=1; 491if (my $pid = fork) { 492 sleep 1; 493 print "1\n"; 494 kill 'TERM', $pid; 495 waitpid($pid, 0); 496 print "4\n"; 497} 498else { 499 $SIG{TERM} = sub { print "2\n" }; 500 sleep 10; 501 print "3\n"; 502} 503EXPECT 5041 5052 5063 5074 508######## 509# this used to SEGV. RT # 121721 510$|=1; 511&main; 512sub main { 513 if (my $pid = fork) { 514 waitpid($pid, 0); 515 } 516 else { 517 print "foo\n"; 518 } 519} 520EXPECT 521foo 522