[perl #92828] eintr.t hangs on FreeBSD
authorDavid Mitchell <davem@iabyn.com>
Wed, 15 Jun 2011 14:07:57 +0000 (15:07 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 15 Jun 2011 14:11:27 +0000 (15:11 +0100)
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.

t/io/eintr.t

index 90fce80..a36b427 100644 (file)
@@ -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);
 }