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 skip "LSAN noise failing to create a thread due to limits" 25 if $Config::Config{ccflags} =~ /sanitize=address/; 26 my $probe = qx{ 27 $shell -c 'ulimit -u 1 2>/dev/null && echo good' 28 }; 29 chomp $probe; 30 skip "Can't set ulimit -u on this system: $probe" 31 unless $probe eq 'good'; 32 33 my $out = qx{ 34 $shell -c 'ulimit -u 1; exec $^X -e " 35 print((() = fork) == 1 ? q[ok] : q[not ok]) 36 "' 37 }; 38 # perl #117141 39 skip "fork() didn't fail, maybe you're running as root", 1 40 if $out eq "okok"; 41 is($out, "ok", "bash/zsh-only test for 'fork' returning undef on failure"); 42} 43 44done_testing(); 45 46__END__ 47$| = 1; 48if ($cid = fork) { 49 sleep 1; 50 if ($result = (kill 9, $cid)) { 51 print "ok 2\n"; 52 } 53 else { 54 print "not ok 2 $result\n"; 55 } 56 sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug 57} 58else { 59 print "ok 1\n"; 60 sleep 10; 61} 62EXPECT 63OPTION random 64ok 1 65ok 2 66######## 67$| = 1; 68if ($cid = fork) { 69 sleep 1; 70 print "not " unless kill 'INT', $cid; 71 print "ok 2\n"; 72} 73else { 74 # XXX On Windows the default signal handler kills the 75 # XXX whole process, not just the thread (pseudo-process) 76 $SIG{INT} = sub { exit }; 77 print "ok 1\n"; 78 sleep 5; 79 die; 80} 81EXPECT 82OPTION random 83ok 1 84ok 2 85######## 86$| = 1; 87sub forkit { 88 print "iteration $i start\n"; 89 my $x = fork; 90 if (defined $x) { 91 if ($x) { 92 print "iteration $i parent\n"; 93 } 94 else { 95 print "iteration $i child\n"; 96 } 97 } 98 else { 99 print "pid $$ failed to fork\n"; 100 } 101} 102while ($i++ < 3) { do { forkit(); }; } 103EXPECT 104OPTION random 105iteration 1 start 106iteration 1 parent 107iteration 1 child 108iteration 2 start 109iteration 2 parent 110iteration 2 child 111iteration 2 start 112iteration 2 parent 113iteration 2 child 114iteration 3 start 115iteration 3 parent 116iteration 3 child 117iteration 3 start 118iteration 3 parent 119iteration 3 child 120iteration 3 start 121iteration 3 parent 122iteration 3 child 123iteration 3 start 124iteration 3 parent 125iteration 3 child 126######## 127$| = 1; 128fork() 129 ? (print("parent\n"),sleep(1)) 130 : (print("child\n"),exit) ; 131EXPECT 132OPTION random 133parent 134child 135######## 136$| = 1; 137fork() 138 ? (print("parent\n"),exit) 139 : (print("child\n"),sleep(1)) ; 140EXPECT 141OPTION random 142parent 143child 144######## 145$| = 1; 146@a = (1..3); 147for (@a) { 148 if (fork) { 149 print "parent $_\n"; 150 $_ = "[$_]"; 151 } 152 else { 153 print "child $_\n"; 154 $_ = "-$_-"; 155 } 156} 157print "@a\n"; 158EXPECT 159OPTION random 160parent 1 161child 1 162parent 2 163child 2 164parent 2 165child 2 166parent 3 167child 3 168parent 3 169child 3 170parent 3 171child 3 172parent 3 173child 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[1] -2- -3- 181-1- -2- -3- 182######## 183$| = 1; 184foreach my $c (1,2,3) { 185 if (fork) { 186 print "parent $c\n"; 187 } 188 else { 189 print "child $c\n"; 190 exit; 191 } 192} 193while (wait() != -1) { print "waited\n" } 194EXPECT 195OPTION random 196child 1 197child 2 198child 3 199parent 1 200parent 2 201parent 3 202waited 203waited 204waited 205######## 206use Config; 207$| = 1; 208$\ = "\n"; 209fork() 210 ? print($Config{osname} eq $^O) 211 : print($Config{osname} eq $^O) ; 212EXPECT 213OPTION random 2141 2151 216######## 217$| = 1; 218$\ = "\n"; 219fork() 220 ? do { require Config; print($Config::Config{osname} eq $^O); } 221 : do { require Config; print($Config::Config{osname} eq $^O); } 222EXPECT 223OPTION random 2241 2251 226######## 227$| = 1; 228use Cwd; 229my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works. 230$\ = "\n"; 231my $dir; 232if (fork) { 233 $dir = "f$$.tst"; 234 mkdir $dir, 0755; 235 chdir $dir; 236 print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent"; 237 chdir ".."; 238 rmdir $dir; 239} 240else { 241 sleep 2; 242 $dir = "f$$.tst"; 243 mkdir $dir, 0755; 244 chdir $dir; 245 print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child"; 246 chdir ".."; 247 rmdir $dir; 248} 249EXPECT 250OPTION random 251ok 1 parent 252ok 1 child 253######## 254$| = 1; 255$\ = "\n"; 256my $getenv; 257if ($^O eq 'MSWin32') { 258 $getenv = qq[$^X -e "print \$ENV{TST}"]; 259} 260else { 261 $getenv = qq[$^X -e 'print \$ENV{TST}']; 262} 263$ENV{TST} = 'foo'; 264if (fork) { 265 sleep 1; 266 print "parent before: " . `$getenv`; 267 $ENV{TST} = 'bar'; 268 print "parent after: " . `$getenv`; 269} 270else { 271 print "child before: " . `$getenv`; 272 $ENV{TST} = 'baz'; 273 print "child after: " . `$getenv`; 274} 275EXPECT 276OPTION random 277child before: foo 278child after: baz 279parent before: foo 280parent after: bar 281######## 282$| = 1; 283$\ = "\n"; 284if ($pid = fork) { 285 waitpid($pid,0); 286 print "parent got $?" 287} 288else { 289 exit(42); 290} 291EXPECT 292OPTION random 293parent got 10752 294######## 295$| = 1; 296$\ = "\n"; 297my $echo = 'echo'; 298if ($^O =~ /android/) { 299 $echo = q{sh -c 'echo $@' -- }; 300} 301if ($pid = fork) { 302 waitpid($pid,0); 303 print "parent got $?" 304} 305else { 306 exec("$echo foo"); 307} 308EXPECT 309OPTION random 310foo 311parent got 0 312######## 313if (fork) { 314 die "parent died"; 315} 316else { 317 die "child died"; 318} 319EXPECT 320OPTION random 321parent died at - line 2. 322child died at - line 5. 323######## 324if ($pid = fork) { 325 eval { die "parent died" }; 326 print $@; 327} 328else { 329 eval { die "child died" }; 330 print $@; 331} 332EXPECT 333OPTION random 334parent died at - line 2. 335child died at - line 6. 336######## 337if (eval q{$pid = fork}) { 338 eval q{ die "parent died" }; 339 print $@; 340} 341else { 342 eval q{ die "child died" }; 343 print $@; 344} 345EXPECT 346OPTION random 347parent died at (eval 2) line 1. 348child died at (eval 2) line 1. 349######## 350BEGIN { 351 $| = 1; 352 fork and exit; 353 print "inner\n"; 354} 355# XXX In emulated fork(), the child will not execute anything after 356# the BEGIN block, due to difficulties in recreating the parse stacks 357# and restarting yyparse() midstream in the child. This can potentially 358# be overcome by treating what's after the BEGIN{} as a brand new parse. 359#print "outer\n" 360EXPECT 361OPTION random 362inner 363######## 364sub pipe_to_fork ($$) { 365 my $parent = shift; 366 my $child = shift; 367 pipe($child, $parent) or die; 368 my $pid = fork(); 369 die "fork() failed: $!" unless defined $pid; 370 close($pid ? $child : $parent); 371 $pid; 372} 373 374if (pipe_to_fork('PARENT','CHILD')) { 375 # parent 376 print PARENT "pipe_to_fork\n"; 377 close PARENT; 378} 379else { 380 # child 381 while (<CHILD>) { print; } 382 close CHILD; 383 exit; 384} 385 386sub pipe_from_fork ($$) { 387 my $parent = shift; 388 my $child = shift; 389 pipe($parent, $child) or die; 390 my $pid = fork(); 391 die "fork() failed: $!" unless defined $pid; 392 close($pid ? $child : $parent); 393 $pid; 394} 395 396if (pipe_from_fork('PARENT','CHILD')) { 397 # parent 398 while (<PARENT>) { print; } 399 close PARENT; 400} 401else { 402 # child 403 print CHILD "pipe_from_fork\n"; 404 close CHILD; 405 exit; 406} 407EXPECT 408OPTION random 409pipe_from_fork 410pipe_to_fork 411######## 412$|=1; 413if ($pid = fork()) { 414 print "forked first kid\n"; 415 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; 416} 417else { 418 print "first child\n"; 419 exit(0); 420} 421if ($pid = fork()) { 422 print "forked second kid\n"; 423 print "wait() returned ok\n" if wait() == $pid; 424} 425else { 426 print "second child\n"; 427 exit(0); 428} 429EXPECT 430OPTION random 431forked first kid 432first child 433waitpid() returned ok 434forked second kid 435second child 436wait() returned ok 437######## 438pipe(RDR,WTR) or die $!; 439my $pid = fork; 440die "fork: $!" if !defined $pid; 441if ($pid == 0) { 442 close RDR; 443 print WTR "STRING_FROM_CHILD\n"; 444 close WTR; 445} else { 446 close WTR; 447 chomp(my $string_from_child = <RDR>); 448 close RDR; 449 print $string_from_child eq "STRING_FROM_CHILD", "\n"; 450} 451EXPECT 452OPTION random 4531 454######## 455# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation 456sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2); 457EXPECT 458OPTION random 4591 4601 461######## 462# [perl #72604] @DB::args stops working across Win32 fork 463$|=1; 464sub f { 465 if ($pid = fork()) { 466 print "waitpid() returned ok\n" if waitpid($pid,0) == $pid; 467 } 468 else { 469 package DB; 470 my @c = caller(0); 471 print "child: called as [$c[3](", join(',',@DB::args), ")]\n"; 472 exit(0); 473 } 474} 475f("foo", "bar"); 476EXPECT 477OPTION random 478child: called as [main::f(foo,bar)] 479waitpid() returned ok 480######## 481# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 482system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}"; 483print $?>>8, "\n"; 484EXPECT 4850 486######## 487# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 488system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}"; 489print $?>>8, "\n"; 490EXPECT 4910 492######## 493# Windows fork() emulation: can we still waitpid() after signalling SIGTERM? 494$|=1; 495if (my $pid = fork) { 496 sleep 1; 497 print "1\n"; 498 kill 'TERM', $pid; 499 waitpid($pid, 0); 500 print "4\n"; 501} 502else { 503 $SIG{TERM} = sub { print "2\n" }; 504 sleep 10; 505 print "3\n"; 506} 507EXPECT 5081 5092 5103 5114 512######## 513# this used to SEGV. RT # 121721 514$|=1; 515&main; 516sub main { 517 if (my $pid = fork) { 518 waitpid($pid, 0); 519 } 520 else { 521 print "foo\n"; 522 } 523} 524EXPECT 525foo 526######## 527# ${^GLOBAL_PHASE} at the end of a pseudo-fork 528if (my $pid = fork) { 529 waitpid $pid, 0; 530} else { 531 eval 'END { print "${^GLOBAL_PHASE}\n" }'; 532 exit; 533} 534EXPECT 535END 536