BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
- $ENV{PERL5LIB} = "../lib";
require './test.pl';
require Config;
skip_all('no fork')
unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork});
}
-skip_all('fork/status problems on MPE/iX')
- if $^O eq 'mpeix';
-
$|=1;
run_multiple_progs('', \*DATA);
+my $shell = $ENV{SHELL} || '';
+SKIP: {
+ skip "This test can only be run under bash or zsh"
+ unless $shell =~ m{/(?:ba|z)sh$};
+ my $probe = qx{
+ $shell -c 'ulimit -u 1 2>&1 && echo good'
+ };
+ chomp $probe;
+ skip "Can't set ulimit -u on this system: $probe"
+ unless $probe eq 'good';
+
+ my $out = qx{
+ $shell -c 'ulimit -u 1; exec $^X -e "
+ print((() = fork) == 1 ? q[ok] : q[not ok])
+ "'
+ };
+ # perl #117141
+ skip "fork() didn't fail, maybe you're running as root", 1
+ if $out eq "okok";
+ is($out, "ok", "bash/zsh-only test for 'fork' returning undef on failure");
+}
+
done_testing();
__END__
$| = 1;
$\ = "\n";
my $echo = 'echo';
+if ($^O =~ /android/) {
+ $echo = q{sh -c 'echo $@' -- };
+}
if ($pid = fork) {
waitpid($pid,0);
print "parent got $?"
OPTION random
child: called as [main::f(foo,bar)]
waitpid() returned ok
+########
+# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
+system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}";
+print $?>>8, "\n";
+EXPECT
+0
+########
+# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
+system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}";
+print $?>>8, "\n";
+EXPECT
+0
+########
+# Windows fork() emulation: can we still waitpid() after signalling SIGTERM?
+$|=1;
+if (my $pid = fork) {
+ sleep 1;
+ print "1\n";
+ kill 'TERM', $pid;
+ waitpid($pid, 0);
+ print "4\n";
+}
+else {
+ $SIG{TERM} = sub { print "2\n" };
+ sleep 10;
+ print "3\n";
+}
+EXPECT
+1
+2
+3
+4
+########
+# this used to SEGV. RT # 121721
+$|=1;
+&main;
+sub main {
+ if (my $pid = fork) {
+ waitpid($pid, 0);
+ }
+ else {
+ print "foo\n";
+ }
+}
+EXPECT
+foo