[perl #92828] eintr.t hangs on FreeBSD

My commit df375c6d048b938ecdeaecc7b264a7f1a190120a attempted to
convert t/io/eintr.t from OS-based skipping to capability-based skipping,
but it only tested whether reads from pipes are interruptible.
Some OSes (like FreeBSD) only hang on write; so probe for that too.

1 files changed, 29 insertions, 0 deletions

diff --git a/t/io/eintr.t b/t/io/eintr.t
index 90fce80a97..a36b4275df 100644
--- a/t/io/eintr.t
+++ b/t/io/eintr.t
@@ -50,6 +50,7 @@ if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/  ) {
 
 {
 	my $pipe;
+	note("checking for read interruptibility...");
 	my $pid = eval { open($pipe, '-|') };
 	unless (defined $pid) {
 		skip_all("can't do -| open");
@@ -75,6 +76,34 @@ if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/  ) {
 		exit 0;
 	}
 	alarm(0);
+
+	$SIG{PIPE} = 'IGNORE';
+
+	note("checking for write interruptibility...");
+	$pid = eval { open($pipe, '|-') };
+	unless (defined $pid) {
+		skip_all("can't do |- open");
+		exit 0;
+	}
+	unless ($pid) {
+		#child
+		sleep 3;
+		close $pipe;
+		exit 0;
+	}
+
+	# parent
+
+	$intr = 0;
+	my $buf = "a" x 1_000_000 . "\n"; # bigger than any pipe buffer hopefully
+	alarm(1);
+	$x = print $pipe $buf;
+
+	unless ($intr) {
+		skip_all("writes aren't interruptible");
+		exit 0;
+	}
+	alarm(0);
 }