This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get t/uni/cache.t working under minitest
[perl5.git] / t / op / fork.t
index 3c40394..60c991b 100644 (file)
@@ -5,20 +5,38 @@
 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__
@@ -273,6 +291,9 @@ parent got 10752
 $| = 1;
 $\ = "\n";
 my $echo = 'echo';
+if ($^O =~ /android/) {
+    $echo = q{sh -c 'echo $@' -- };
+}
 if ($pid = fork) {
     waitpid($pid,0);
     print "parent got $?"
@@ -452,3 +473,49 @@ EXPECT
 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