BEGIN {
chdir 't' if -d 't';
- unshift @INC, '../lib';
+ @INC = '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}
- or ($^O eq 'MSWin32' and $Config{useithreads}
- and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/))
- {
+ unless ($Config{'d_fork'} or $Config{'d_pseudofork'}) {
print "1..0 # Skip: no fork\n";
exit 0;
}
$ENV{PERL5LIB} = "../lib";
}
+if ($^O eq 'mpeix') {
+ print "1..0 # Skip: fork/status problems on MPE/iX\n";
+ exit 0;
+}
+
$|=1;
undef $/;
1 while -f ++$tmpfile;
END { close TEST; unlink $tmpfile if $tmpfile; }
-$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
+$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat'));
for (@prgs){
my $switch;
if ($^O eq 'MSWin32') {
$results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
}
+ elsif ($^O eq 'NetWare') {
+ $results = `perl -I../lib $switch $tmpfile 2>&1`;
+ }
else {
$results = `./perl $switch $tmpfile 2>&1`;
}
ok 2
########
$| = 1;
+if ($cid = fork) {
+ sleep 1;
+ print "not " unless kill 'INT', $cid;
+ print "ok 2\n";
+}
+else {
+ # XXX On Windows the default signal handler kills the
+ # XXX whole process, not just the thread (pseudo-process)
+ $SIG{INT} = sub { exit };
+ print "ok 1\n";
+ sleep 5;
+ die;
+}
+EXPECT
+ok 1
+ok 2
+########
+$| = 1;
sub forkit {
print "iteration $i start\n";
my $x = fork;
[1] -2- -3-
-1- -2- -3-
########
+$| = 1;
+foreach my $c (1,2,3) {
+ if (fork) {
+ print "parent $c\n";
+ }
+ else {
+ print "child $c\n";
+ exit;
+ }
+}
+while (wait() != -1) { print "waited\n" }
+EXPECT
+child 1
+child 2
+child 3
+parent 1
+parent 2
+parent 3
+waited
+waited
+waited
+########
use Config;
$| = 1;
$\ = "\n";
########
$| = 1;
use Cwd;
+my $cwd = cwd(); # Make sure we load Win32.pm while "../lib" still works.
$\ = "\n";
my $dir;
if (fork) {
$| = 1;
$\ = "\n";
my $getenv;
-if ($^O eq 'MSWin32') {
+if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
$getenv = qq[$^X -e "print \$ENV{TST}"];
}
else {
EXPECT
pipe_from_fork
pipe_to_fork
+########
+$|=1;
+if ($pid = fork()) {
+ print "forked first kid\n";
+ print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
+}
+else {
+ print "first child\n";
+ exit(0);
+}
+if ($pid = fork()) {
+ print "forked second kid\n";
+ print "wait() returned ok\n" if wait() == $pid;
+}
+else {
+ print "second child\n";
+ exit(0);
+}
+EXPECT
+forked first kid
+first child
+waitpid() returned ok
+forked second kid
+second child
+wait() returned ok
+########
+pipe(RDR,WTR) or die $!;
+my $pid = fork;
+die "fork: $!" if !defined $pid;
+if ($pid == 0) {
+ my $rand_child = rand;
+ close RDR;
+ print WTR $rand_child, "\n";
+ close WTR;
+} else {
+ my $rand_parent = rand;
+ close WTR;
+ chomp(my $rand_child = <RDR>);
+ close RDR;
+ print $rand_child ne $rand_parent, "\n";
+}
+EXPECT
+1
+########
+# [perl #39145] Perl_dounwind() crashing with Win32's fork() emulation
+sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
+EXPECT
+1
+1