diff options
Diffstat (limited to 'contrib/perl5/t/op/fork.t')
| -rwxr-xr-x | contrib/perl5/t/op/fork.t | 368 |
1 files changed, 359 insertions, 9 deletions
diff --git a/contrib/perl5/t/op/fork.t b/contrib/perl5/t/op/fork.t index 9790ff0..80c0b72 100755 --- a/contrib/perl5/t/op/fork.t +++ b/contrib/perl5/t/op/fork.t @@ -1,26 +1,376 @@ #!./perl -# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $ +# tests for both real and emulated fork() BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib'; require Config; import Config; - unless ($Config{'d_fork'}) { - print "1..0\n"; + unless ($Config{'d_fork'} + or ($^O eq 'MSWin32' and $Config{useithreads} + and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/)) + { + print "1..0 # Skip: no fork\n"; exit 0; } + $ENV{PERL5LIB} = "../lib"; } -$| = 1; -print "1..2\n"; +if ($^O eq 'mpeix') { + print "1..0 # Skip: fork/status problems on MPE/iX\n"; + exit 0; +} + +$|=1; + +undef $/; +@prgs = split "\n########\n", <DATA>; +print "1..", scalar @prgs, "\n"; + +$tmpfile = "forktmp000"; +1 while -f ++$tmpfile; +END { close TEST; unlink $tmpfile if $tmpfile; } + +$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); + +for (@prgs){ + my $switch; + if (s/^\s*(-\w.*)//){ + $switch = $1; + } + my($prog,$expected) = split(/\nEXPECT\n/, $_); + $expected =~ s/\n+$//; + # results can be in any order, so sort 'em + my @expected = sort split /\n/, $expected; + open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!"; + print TEST $prog, "\n"; + close TEST or die "Cannot close $tmpfile: $!"; + my $results; + if ($^O eq 'MSWin32') { + $results = `.\\perl -I../lib $switch $tmpfile 2>&1`; + } + else { + $results = `./perl $switch $tmpfile 2>&1`; + } + $status = $?; + $results =~ s/\n+$//; + $results =~ s/at\s+forktmp\d+\s+line/at - line/g; + $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g; +# bison says 'parse error' instead of 'syntax error', +# various yaccs may or may not capitalize 'syntax'. + $results =~ s/^(syntax|parse) error/syntax error/mig; + $results =~ s/^\n*Process terminated by SIG\w+\n?//mg + if $^O eq 'os2'; + my @results = sort split /\n/, $results; + if ( "@results" ne "@expected" ) { + print STDERR "PROG: $switch\n$prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; +} +__END__ +$| = 1; if ($cid = fork) { - sleep 2; - if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";} + sleep 1; + if ($result = (kill 9, $cid)) { + print "ok 2\n"; + } + else { + print "not ok 2 $result\n"; + } + sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug } else { - $| = 1; print "ok 1\n"; sleep 10; } +EXPECT +ok 1 +ok 2 +######## +$| = 1; +sub forkit { + print "iteration $i start\n"; + my $x = fork; + if (defined $x) { + if ($x) { + print "iteration $i parent\n"; + } + else { + print "iteration $i child\n"; + } + } + else { + print "pid $$ failed to fork\n"; + } +} +while ($i++ < 3) { do { forkit(); }; } +EXPECT +iteration 1 start +iteration 1 parent +iteration 1 child +iteration 2 start +iteration 2 parent +iteration 2 child +iteration 2 start +iteration 2 parent +iteration 2 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +######## +$| = 1; +fork() + ? (print("parent\n"),sleep(1)) + : (print("child\n"),exit) ; +EXPECT +parent +child +######## +$| = 1; +fork() + ? (print("parent\n"),exit) + : (print("child\n"),sleep(1)) ; +EXPECT +parent +child +######## +$| = 1; +@a = (1..3); +for (@a) { + if (fork) { + print "parent $_\n"; + $_ = "[$_]"; + } + else { + print "child $_\n"; + $_ = "-$_-"; + } +} +print "@a\n"; +EXPECT +parent 1 +child 1 +parent 2 +child 2 +parent 2 +child 2 +parent 3 +child 3 +parent 3 +child 3 +parent 3 +child 3 +parent 3 +child 3 +[1] [2] [3] +-1- [2] [3] +[1] -2- [3] +[1] [2] -3- +-1- -2- [3] +-1- [2] -3- +[1] -2- -3- +-1- -2- -3- +######## +use Config; +$| = 1; +$\ = "\n"; +fork() + ? print($Config{osname} eq $^O) + : print($Config{osname} eq $^O) ; +EXPECT +1 +1 +######## +$| = 1; +$\ = "\n"; +fork() + ? do { require Config; print($Config::Config{osname} eq $^O); } + : do { require Config; print($Config::Config{osname} eq $^O); } +EXPECT +1 +1 +######## +$| = 1; +use Cwd; +$\ = "\n"; +my $dir; +if (fork) { + $dir = "f$$.tst"; + mkdir $dir, 0755; + chdir $dir; + print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent"; + chdir ".."; + rmdir $dir; +} +else { + sleep 2; + $dir = "f$$.tst"; + mkdir $dir, 0755; + chdir $dir; + print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child"; + chdir ".."; + rmdir $dir; +} +EXPECT +ok 1 parent +ok 1 child +######## +$| = 1; +$\ = "\n"; +my $getenv; +if ($^O eq 'MSWin32') { + $getenv = qq[$^X -e "print \$ENV{TST}"]; +} +else { + $getenv = qq[$^X -e 'print \$ENV{TST}']; +} +$ENV{TST} = 'foo'; +if (fork) { + sleep 1; + print "parent before: " . `$getenv`; + $ENV{TST} = 'bar'; + print "parent after: " . `$getenv`; +} +else { + print "child before: " . `$getenv`; + $ENV{TST} = 'baz'; + print "child after: " . `$getenv`; +} +EXPECT +child before: foo +child after: baz +parent before: foo +parent after: bar +######## +$| = 1; +$\ = "\n"; +if ($pid = fork) { + waitpid($pid,0); + print "parent got $?" +} +else { + exit(42); +} +EXPECT +parent got 10752 +######## +$| = 1; +$\ = "\n"; +my $echo = 'echo'; +if ($pid = fork) { + waitpid($pid,0); + print "parent got $?" +} +else { + exec("$echo foo"); +} +EXPECT +foo +parent got 0 +######## +if (fork) { + die "parent died"; +} +else { + die "child died"; +} +EXPECT +parent died at - line 2. +child died at - line 5. +######## +if ($pid = fork) { + eval { die "parent died" }; + print $@; +} +else { + eval { die "child died" }; + print $@; +} +EXPECT +parent died at - line 2. +child died at - line 6. +######## +if (eval q{$pid = fork}) { + eval q{ die "parent died" }; + print $@; +} +else { + eval q{ die "child died" }; + print $@; +} +EXPECT +parent died at (eval 2) line 1. +child died at (eval 2) line 1. +######## +BEGIN { + $| = 1; + fork and exit; + print "inner\n"; +} +# XXX In emulated fork(), the child will not execute anything after +# the BEGIN block, due to difficulties in recreating the parse stacks +# and restarting yyparse() midstream in the child. This can potentially +# be overcome by treating what's after the BEGIN{} as a brand new parse. +#print "outer\n" +EXPECT +inner +######## +sub pipe_to_fork ($$) { + my $parent = shift; + my $child = shift; + pipe($child, $parent) or die; + my $pid = fork(); + die "fork() failed: $!" unless defined $pid; + close($pid ? $child : $parent); + $pid; +} + +if (pipe_to_fork('PARENT','CHILD')) { + # parent + print PARENT "pipe_to_fork\n"; + close PARENT; +} +else { + # child + while (<CHILD>) { print; } + close CHILD; + exit; +} + +sub pipe_from_fork ($$) { + my $parent = shift; + my $child = shift; + pipe($parent, $child) or die; + my $pid = fork(); + die "fork() failed: $!" unless defined $pid; + close($pid ? $child : $parent); + $pid; +} + +if (pipe_from_fork('PARENT','CHILD')) { + # parent + while (<PARENT>) { print; } + close PARENT; +} +else { + # child + print CHILD "pipe_from_fork\n"; + close CHILD; + exit; +} +EXPECT +pipe_from_fork +pipe_to_fork |
