3 # tests for both real and emulated fork()
7 unshift @INC, '../lib';
8 require Config; import Config;
9 unless ($Config{'d_fork'} || $Config{ccflags} =~ /-DUSE_ITHREADS\b/) {
10 print "1..0 # Skip: no fork\n";
13 $ENV{PERL5LIB} = "../lib";
19 @prgs = split "\n########\n", <DATA>;
20 print "1..", scalar @prgs, "\n";
22 $tmpfile = "forktmp000";
23 1 while -f ++$tmpfile;
24 END { unlink $tmpfile if $tmpfile; }
26 $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
33 my($prog,$expected) = split(/\nEXPECT\n/, $_);
34 $expected =~ s/\n+$//;
35 # results can be in any order, so sort 'em
36 my @expected = sort split /\n/, $expected;
37 open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
38 print TEST $prog, "\n";
39 close TEST or die "Cannot close $tmpfile: $!";
41 if ($^O eq 'MSWin32') {
42 $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
45 $results = `./perl $switch $tmpfile 2>&1`;
49 $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
50 $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
51 # bison says 'parse error' instead of 'syntax error',
52 # various yaccs may or may not capitalize 'syntax'.
53 $results =~ s/^(syntax|parse) error/syntax error/mig;
54 my @results = sort split /\n/, $results;
55 if ( "@results" ne "@expected" ) {
56 print STDERR "PROG: $switch\n$prog\n";
57 print STDERR "EXPECTED:\n$expected\n";
58 print STDERR "GOT:\n$results\n";
61 print "ok ", ++$i, "\n";
68 if ($result = (kill 9, $cid)) {
72 print "not ok 2 $result\n";
74 sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug
86 print "iteration $i start\n";
90 print "iteration $i parent\n";
93 print "iteration $i child\n";
97 print "pid $$ failed to fork\n";
100 while ($i++ < 3) { do { forkit(); }; }
126 ? (print("parent\n"),sleep(1))
127 : (print("child\n"),exit) ;
134 ? (print("parent\n"),exit)
135 : (print("child\n"),sleep(1)) ;
181 ? print($Config{osname} eq $^O)
182 : print($Config{osname} eq $^O) ;
190 ? do { require Config; print($Config::Config{osname} eq $^O); }
191 : do { require Config; print($Config::Config{osname} eq $^O); }
204 print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent";
213 print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child";
224 if ($^O eq 'MSWin32') {
225 $getenv = qq[$^X -e "print \$ENV{TST}"];
228 $getenv = qq[$^X -e 'print \$ENV{TST}'];
233 print "parent: " . `$getenv`;
237 print "child: " . `$getenv`;
248 print "parent got $?"
261 print "parent got $?"
277 parent died at - line 2.
278 child died at - line 5.
281 eval { die "parent died" };
285 eval { die "child died" };
289 parent died at - line 2.
290 child died at - line 6.
292 if (eval q{$pid = fork}) {
293 eval q{ die "parent died" };
297 eval q{ die "child died" };
301 parent died at (eval 2) line 1.
302 child died at (eval 2) line 1.
309 # XXX In emulated fork(), the child will not execute anything after
310 # the BEGIN block, due to difficulties in recreating the parse stacks
311 # and restarting yyparse() midstream in the child. This can potentially
312 # be overcome by treating what's after the BEGIN{} as a brand new parse.