3 # tests for both real and emulated fork()
7 unshift @INC, '../lib';
8 require Config; import Config;
9 unless ($Config{'d_fork'}
10 or ($^O eq 'MSWin32' and $Config{useithreads}
11 and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/))
13 print "1..0 # Skip: no fork\n";
16 $ENV{PERL5LIB} = "../lib";
22 @prgs = split "\n########\n", <DATA>;
23 print "1..", scalar @prgs, "\n";
25 $tmpfile = "forktmp000";
26 1 while -f ++$tmpfile;
27 END { close TEST; unlink $tmpfile if $tmpfile; }
29 $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
36 my($prog,$expected) = split(/\nEXPECT\n/, $_);
37 $expected =~ s/\n+$//;
38 # results can be in any order, so sort 'em
39 my @expected = sort split /\n/, $expected;
40 open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
41 print TEST $prog, "\n";
42 close TEST or die "Cannot close $tmpfile: $!";
44 if ($^O eq 'MSWin32') {
45 $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
48 $results = `./perl $switch $tmpfile 2>&1`;
52 $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
53 $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
54 # bison says 'parse error' instead of 'syntax error',
55 # various yaccs may or may not capitalize 'syntax'.
56 $results =~ s/^(syntax|parse) error/syntax error/mig;
57 $results =~ s/^\n*Process terminated by SIG\w+\n?//mg
59 my @results = sort split /\n/, $results;
60 if ( "@results" ne "@expected" ) {
61 print STDERR "PROG: $switch\n$prog\n";
62 print STDERR "EXPECTED:\n$expected\n";
63 print STDERR "GOT:\n$results\n";
66 print "ok ", ++$i, "\n";
73 if ($result = (kill 9, $cid)) {
77 print "not ok 2 $result\n";
79 sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug
91 print "iteration $i start\n";
95 print "iteration $i parent\n";
98 print "iteration $i child\n";
102 print "pid $$ failed to fork\n";
105 while ($i++ < 3) { do { forkit(); }; }
131 ? (print("parent\n"),sleep(1))
132 : (print("child\n"),exit) ;
139 ? (print("parent\n"),exit)
140 : (print("child\n"),sleep(1)) ;
186 ? print($Config{osname} eq $^O)
187 : print($Config{osname} eq $^O) ;
195 ? do { require Config; print($Config::Config{osname} eq $^O); }
196 : do { require Config; print($Config::Config{osname} eq $^O); }
209 print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent";
218 print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child";
229 if ($^O eq 'MSWin32') {
230 $getenv = qq[$^X -e "print \$ENV{TST}"];
233 $getenv = qq[$^X -e 'print \$ENV{TST}'];
238 print "parent before: " . `$getenv`;
240 print "parent after: " . `$getenv`;
243 print "child before: " . `$getenv`;
245 print "child after: " . `$getenv`;
257 print "parent got $?"
270 print "parent got $?"
286 parent died at - line 2.
287 child died at - line 5.
290 eval { die "parent died" };
294 eval { die "child died" };
298 parent died at - line 2.
299 child died at - line 6.
301 if (eval q{$pid = fork}) {
302 eval q{ die "parent died" };
306 eval q{ die "child died" };
310 parent died at (eval 2) line 1.
311 child died at (eval 2) line 1.
318 # XXX In emulated fork(), the child will not execute anything after
319 # the BEGIN block, due to difficulties in recreating the parse stacks
320 # and restarting yyparse() midstream in the child. This can potentially
321 # be overcome by treating what's after the BEGIN{} as a brand new parse.
326 sub pipe_to_fork ($$) {
329 pipe($child, $parent) or die;
331 die "fork() failed: $!" unless defined $pid;
332 close($pid ? $child : $parent);
336 if (pipe_to_fork('PARENT','CHILD')) {
338 print PARENT "pipe_to_fork\n";
343 while (<CHILD>) { print; }
348 sub pipe_from_fork ($$) {
351 pipe($parent, $child) or die;
353 die "fork() failed: $!" unless defined $pid;
354 close($pid ? $child : $parent);
358 if (pipe_from_fork('PARENT','CHILD')) {
360 while (<PARENT>) { print; }
365 print CHILD "pipe_from_fork\n";