[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.

diff --git a/t/io/eintr.t b/t/io/eintr.t
index 90fce80..a36b427 100644 (file)
--- 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);
 }