t/op/fork.t

   1 #!./perl
   2
   3 # tests for both real and emulated fork()
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8     $ENV{PERL5LIB} = "../lib";
   9     require './test.pl';
  10     require Config;
  11     skip_all('no fork')
  12         unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork});
  13 }
  14
  15 skip_all('fork/status problems on MPE/iX')
  16     if $^O eq 'mpeix';
  17
  18 $|=1;
  19
  20 run_multiple_progs('', \*DATA);
  21
  22 done_testing();
  23
  24 __END__
  25 $| = 1;
  26 if ($cid = fork) {
  27     sleep 1;
  28     if ($result = (kill 9, $cid)) {
  29         print "ok 2\n";
  30     }
  31     else {
  32         print "not ok 2 $result\n";
  33     }
  34     sleep 1 if $^O eq 'MSWin32';        # avoid WinNT race bug
  35 }
  36 else {
  37     print "ok 1\n";
  38     sleep 10;
  39 }
  40 EXPECT
  41 OPTION random
  42 ok 1
  43 ok 2
  44 ########
  45 $| = 1;
  46 if ($cid = fork) {
  47     sleep 1;
  48     print "not " unless kill 'INT', $cid;
  49     print "ok 2\n";
  50 }
  51 else {
  52     # XXX On Windows the default signal handler kills the
  53     # XXX whole process, not just the thread (pseudo-process)
  54     $SIG{INT} = sub { exit };
  55     print "ok 1\n";
  56     sleep 5;
  57     die;
  58 }
  59 EXPECT
  60 OPTION random
  61 ok 1
  62 ok 2
  63 ########
  64 $| = 1;
  65 sub forkit {
  66     print "iteration $i start\n";
  67     my $x = fork;
  68     if (defined $x) {
  69         if ($x) {
  70             print "iteration $i parent\n";
  71         }
  72         else {
  73             print "iteration $i child\n";
  74         }
  75     }
  76     else {
  77         print "pid $$ failed to fork\n";
  78     }
  79 }
  80 while ($i++ < 3) { do { forkit(); }; }
  81 EXPECT
  82 OPTION random
  83 iteration 1 start
  84 iteration 1 parent
  85 iteration 1 child
  86 iteration 2 start
  87 iteration 2 parent
  88 iteration 2 child
  89 iteration 2 start
  90 iteration 2 parent
  91 iteration 2 child
  92 iteration 3 start
  93 iteration 3 parent
  94 iteration 3 child
  95 iteration 3 start
  96 iteration 3 parent
  97 iteration 3 child
  98 iteration 3 start
  99 iteration 3 parent
 100 iteration 3 child
 101 iteration 3 start
 102 iteration 3 parent
 103 iteration 3 child
 104 ########
 105 $| = 1;
 106 fork()
 107  ? (print("parent\n"),sleep(1))
 108  : (print("child\n"),exit) ;
 109 EXPECT
 110 OPTION random
 111 parent
 112 child
 113 ########
 114 $| = 1;
 115 fork()
 116  ? (print("parent\n"),exit)
 117  : (print("child\n"),sleep(1)) ;
 118 EXPECT
 119 OPTION random
 120 parent
 121 child
 122 ########
 123 $| = 1;
 124 @a = (1..3);
 125 for (@a) {
 126     if (fork) {
 127         print "parent $_\n";
 128         $_ = "[$_]";
 129     }
 130     else {
 131         print "child $_\n";
 132         $_ = "-$_-";
 133     }
 134 }
 135 print "@a\n";
 136 EXPECT
 137 OPTION random
 138 parent 1
 139 child 1
 140 parent 2
 141 child 2
 142 parent 2
 143 child 2
 144 parent 3
 145 child 3
 146 parent 3
 147 child 3
 148 parent 3
 149 child 3
 150 parent 3
 151 child 3
 152 [1] [2] [3]
 153 -1- [2] [3]
 154 [1] -2- [3]
 155 [1] [2] -3-
 156 -1- -2- [3]
 157 -1- [2] -3-
 158 [1] -2- -3-
 159 -1- -2- -3-
 160 ########
 161 $| = 1;
 162 foreach my $c (1,2,3) {
 163     if (fork) {
 164         print "parent $c\n";
 165     }
 166     else {
 167         print "child $c\n";
 168         exit;
 169     }
 170 }
 171 while (wait() != -1) { print "waited\n" }
 172 EXPECT
 173 OPTION random
 174 child 1
 175 child 2
 176 child 3
 177 parent 1
 178 parent 2
 179 parent 3
 180 waited
 181 waited
 182 waited
 183 ########
 184 use Config;
 185 $| = 1;
 186 $\ = "\n";
 187 fork()
 188  ? print($Config{osname} eq $^O)
 189  : print($Config{osname} eq $^O) ;
 190 EXPECT
 191 OPTION random
 192 1
 193 1
 194 ########
 195 $| = 1;
 196 $\ = "\n";
 197 fork()
 198  ? do { require Config; print($Config::Config{osname} eq $^O); }
 199  : do { require Config; print($Config::Config{osname} eq $^O); }
 200 EXPECT
 201 OPTION random
 202 1
 203 1
 204 ########
 205 $| = 1;
 206 use Cwd;
 207 my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works.
 208 $\ = "\n";
 209 my $dir;
 210 if (fork) {
 211     $dir = "f$$.tst";
 212     mkdir $dir, 0755;
 213     chdir $dir;
 214     print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent";
 215     chdir "..";
 216     rmdir $dir;
 217 }
 218 else {
 219     sleep 2;
 220     $dir = "f$$.tst";
 221     mkdir $dir, 0755;
 222     chdir $dir;
 223     print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child";
 224     chdir "..";
 225     rmdir $dir;
 226 }
 227 EXPECT
 228 OPTION random
 229 ok 1 parent
 230 ok 1 child
 231 ########
 232 $| = 1;
 233 $\ = "\n";
 234 my $getenv;
 235 if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
 236     $getenv = qq[$^X -e "print \$ENV{TST}"];
 237 }
 238 else {
 239     $getenv = qq[$^X -e 'print \$ENV{TST}'];
 240 }
 241 $ENV{TST} = 'foo';
 242 if (fork) {
 243     sleep 1;
 244     print "parent before: " . `$getenv`;
 245     $ENV{TST} = 'bar';
 246     print "parent after: " . `$getenv`;
 247 }
 248 else {
 249     print "child before: " . `$getenv`;
 250     $ENV{TST} = 'baz';
 251     print "child after: " . `$getenv`;
 252 }
 253 EXPECT
 254 OPTION random
 255 child before: foo
 256 child after: baz
 257 parent before: foo
 258 parent after: bar
 259 ########
 260 $| = 1;
 261 $\ = "\n";
 262 if ($pid = fork) {
 263     waitpid($pid,0);
 264     print "parent got $?"
 265 }
 266 else {
 267     exit(42);
 268 }
 269 EXPECT
 270 OPTION random
 271 parent got 10752
 272 ########
 273 $| = 1;
 274 $\ = "\n";
 275 my $echo = 'echo';
 276 if ($pid = fork) {
 277     waitpid($pid,0);
 278     print "parent got $?"
 279 }
 280 else {
 281     exec("$echo foo");
 282 }
 283 EXPECT
 284 OPTION random
 285 foo
 286 parent got 0
 287 ########
 288 if (fork) {
 289     die "parent died";
 290 }
 291 else {
 292     die "child died";
 293 }
 294 EXPECT
 295 OPTION random
 296 parent died at - line 2.
 297 child died at - line 5.
 298 ########
 299 if ($pid = fork) {
 300     eval { die "parent died" };
 301     print $@;
 302 }
 303 else {
 304     eval { die "child died" };
 305     print $@;
 306 }
 307 EXPECT
 308 OPTION random
 309 parent died at - line 2.
 310 child died at - line 6.
 311 ########
 312 if (eval q{$pid = fork}) {
 313     eval q{ die "parent died" };
 314     print $@;
 315 }
 316 else {
 317     eval q{ die "child died" };
 318     print $@;
 319 }
 320 EXPECT
 321 OPTION random
 322 parent died at (eval 2) line 1.
 323 child died at (eval 2) line 1.
 324 ########
 325 BEGIN {
 326     $| = 1;
 327     fork and exit;
 328     print "inner\n";
 329 }
 330 # XXX In emulated fork(), the child will not execute anything after
 331 # the BEGIN block, due to difficulties in recreating the parse stacks
 332 # and restarting yyparse() midstream in the child.  This can potentially
 333 # be overcome by treating what's after the BEGIN{} as a brand new parse.
 334 #print "outer\n"
 335 EXPECT
 336 OPTION random
 337 inner
 338 ########
 339 sub pipe_to_fork ($$) {
 340     my $parent = shift;
 341     my $child = shift;
 342     pipe($child, $parent) or die;
 343     my $pid = fork();
 344     die "fork() failed: $!" unless defined $pid;
 345     close($pid ? $child : $parent);
 346     $pid;
 347 }
 348
 349 if (pipe_to_fork('PARENT','CHILD')) {
 350     # parent
 351     print PARENT "pipe_to_fork\n";
 352     close PARENT;
 353 }
 354 else {
 355     # child
 356     while (<CHILD>) { print; }
 357     close CHILD;
 358     exit;
 359 }
 360
 361 sub pipe_from_fork ($$) {
 362     my $parent = shift;
 363     my $child = shift;
 364     pipe($parent, $child) or die;
 365     my $pid = fork();
 366     die "fork() failed: $!" unless defined $pid;
 367     close($pid ? $child : $parent);
 368     $pid;
 369 }
 370
 371 if (pipe_from_fork('PARENT','CHILD')) {
 372     # parent
 373     while (<PARENT>) { print; }
 374     close PARENT;
 375 }
 376 else {
 377     # child
 378     print CHILD "pipe_from_fork\n";
 379     close CHILD;
 380     exit;
 381 }
 382 EXPECT
 383 OPTION random
 384 pipe_from_fork
 385 pipe_to_fork
 386 ########
 387 $|=1;
 388 if ($pid = fork()) {
 389     print "forked first kid\n";
 390     print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
 391 }
 392 else {
 393     print "first child\n";
 394     exit(0);
 395 }
 396 if ($pid = fork()) {
 397     print "forked second kid\n";
 398     print "wait() returned ok\n" if wait() == $pid;
 399 }
 400 else {
 401     print "second child\n";
 402     exit(0);
 403 }
 404 EXPECT
 405 OPTION random
 406 forked first kid
 407 first child
 408 waitpid() returned ok
 409 forked second kid
 410 second child
 411 wait() returned ok
 412 ########
 413 pipe(RDR,WTR) or die $!;
 414 my $pid = fork;
 415 die "fork: $!" if !defined $pid;
 416 if ($pid == 0) {
 417     close RDR;
 418     print WTR "STRING_FROM_CHILD\n";
 419     close WTR;
 420 } else {
 421     close WTR;
 422     chomp(my $string_from_child  = <RDR>);
 423     close RDR;
 424     print $string_from_child eq "STRING_FROM_CHILD", "\n";
 425 }
 426 EXPECT
 427 OPTION random
 428 1
 429 ########
 430 # [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation
 431 sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
 432 EXPECT
 433 OPTION random
 434 1
 435 1
 436 ########
 437 # [perl #72604] @DB::args stops working across Win32 fork
 438 $|=1;
 439 sub f {
 440     if ($pid = fork()) {
 441         print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
 442     }
 443     else {
 444         package DB;
 445         my @c = caller(0);
 446         print "child: called as [$c[3](", join(',',@DB::args), ")]\n";
 447         exit(0);
 448     }
 449 }
 450 f("foo", "bar");
 451 EXPECT
 452 OPTION random
 453 child: called as [main::f(foo,bar)]
 454 waitpid() returned ok
 455 ########
 456 # Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
 457 system $^X,  "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}";
 458 print $?>>8, "\n";
 459 EXPECT
 460 0
 461 ########
 462 # Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
 463 system $^X,  "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}";
 464 print $?>>8, "\n";
 465 EXPECT
 466 0