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 ($pid = fork) { 295 waitpid($pid,0); 296 print "parent got $?" 297} 298else { 299 exec("$echo foo"); 300} 301EXPECT 302OPTION random 303foo 304parent got 0 305######## 306if (fork) { 307 die "parent died"; 308} 309else { 310 die "child died"; 311} 312EXPECT 313OPTION random 314parent died at - line 2. 315child died at - line 5. 316######## 317if ($pid = fork) { 318 eval { die "parent died" }; 319 print $@; 320} 321else { 322 eval { die "child died" }; 323 print $@; 324} 325EXPECT 326OPTION random 327parent died at - line 2. 328child died at - line 6. 329######## 330if (eval q{$pid = fork}) { 331 eval q{ die "parent died" }; 332 print $@; 333} 334else { 335 eval q{ die "child died" }; 336 print $@; 337} 338EXPECT 339OPTION random 340parent died at (eval 2) line 1. 341child died at (eval 2) line 1. 342######## 343BEGIN { 344 $| = 1; 345 fork and exit; 346 print "inner\n"; 347} 348# XXX In emulated fork(), the child will not execute anything after 349# the BEGIN block, due to difficulties in recreating the parse stacks 350# and restarting yyparse() midstream in the child. This can potentially 351# be overcome by treating what's after the BEGIN{} as a brand new parse. 352#print "outer\n" 353EXPECT 354OPTION random 355inner 356######## 357sub pipe_to_fork ($$) { 358 my $parent = shift; 359 my $child = shift; 360 pipe($child, $parent) or die; 361 my $pid = fork(); 362 die "fork() failed: $!" unless defined $pid; 363 close($pid ? $child : $parent); 364 $pid; 365} 366 367if (pipe_to_fork('PARENT','CHILD')) { 368 # parent 369 print PARENT "pipe_to_fork\n"; 370 close PARENT; 371} 372else { 373 # child 374 while (<CHILD>) { print; } 375 close CHILD; 376 exit; 377} 378 379sub pipe_from_fork ($$) { 380 my $parent = shift; 381 my $child = shift; 382 pipe($parent, $child) or die; 383 my $pid = fork(); 384 die "fork() failed: $!" unless defined $pid; 385 close($pid ? $child : $parent); 386 $pid; 387} 388 389if (pipe_from_fork('PARENT','CHILD')) { 390 # parent 391 while (<PARENT>) { print; } 392 close PARENT; 393} 394else { 395 # child 396 print CHILD "pipe_from_fork\n"; 397 close CHILD; 398 exit; 399} 400EXPECT 401OPTION random 402pipe_from_fork 403pipe_to_fork 404######## 405$|=1; 406if ($pid = fork()) { 407 print "forked first kid\n"; 408 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; 409} 410else { 411 print "first child\n"; 412 exit(0); 413} 414if ($pid = fork()) { 415 print "forked second kid\n"; 416 print "wait() returned ok\n" if wait() == $pid; 417} 418else { 419 print "second child\n"; 420 exit(0); 421} 422EXPECT 423OPTION random 424forked first kid 425first child 426waitpid() returned ok 427forked second kid 428second child 429wait() returned ok 430######## 431pipe(RDR,WTR) or die $!; 432my $pid = fork; 433die "fork: $!" if !defined $pid; 434if ($pid == 0) { 435 close RDR; 436 print WTR "STRING_FROM_CHILD\n"; 437 close WTR; 438} else { 439 close WTR; 440 chomp(my $string_from_child = <RDR>); 441 close RDR; 442 print $string_from_child eq "STRING_FROM_CHILD", "\n"; 443} 444EXPECT 445OPTION random 4461 447######## 448# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation 449sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2); 450EXPECT 451OPTION random 4521 4531 454######## 455# [perl #72604] @DB::args stops working across Win32 fork 456$|=1; 457sub f { 458 if ($pid = fork()) { 459 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; 460 } 461 else { 462 package DB; 463 my @c = caller(0); 464 print "child: called as [$c[3](", join(',',@DB::args), ")]\n"; 465 exit(0); 466 } 467} 468f("foo", "bar"); 469EXPECT 470OPTION random 471child: called as [main::f(foo,bar)] 472waitpid() returned ok 473######## 474# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 475system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}"; 476print $?>>8, "\n"; 477EXPECT 4780 479######## 480# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 481system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}"; 482print $?>>8, "\n"; 483EXPECT 4840 485######## 486# Windows fork() emulation: can we still waitpid() after signalling SIGTERM? 487$|=1; 488if (my $pid = fork) { 489 sleep 1; 490 print "1\n"; 491 kill 'TERM', $pid; 492 waitpid($pid, 0); 493 print "4\n"; 494} 495else { 496 $SIG{TERM} = sub { print "2\n" }; 497 sleep 3; 498 print "3\n"; 499} 500EXPECT 5011 5022 5033 5044 505