This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
eintr.t: skip based on capability rather than OS
authorDavid Mitchell <davem@iabyn.com>
Mon, 6 Jun 2011 11:30:01 +0000 (12:30 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 9 Jun 2011 10:23:58 +0000 (11:23 +0100)
The t/io/eintr.t tests require read/write system to calls to be
interruptible (to see if anything nasty can be done by the signal
handler).

Many platforms aren't interruptible, which means the tests would hang.
We currently work round this by skipping based on a hard-coded list of
OSes (such as win32, VMS etc).

Change this so that we instead do an initial test as to whether they are
interruptible, and if not, skip the whole test file.

t/io/eintr.t

index e545228..90fce80 100644 (file)
@@ -40,23 +40,44 @@ if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/  ) {
        exit 0;
 }
 
+# Determine whether this platform seems to support interruptible syscalls.
+#
 # on Win32, alarm() won't interrupt the read/write call.
 # Similar issues with VMS.
 # On FreeBSD, writes to pipes of 8192 bytes or more use a mechanism
 # that is not interruptible (see perl #85842 and #84688).
 # "close during print" also hangs on Solaris 8 (but not 10 or 11).
-#
-# Also skip on release builds, to avoid other possibly problematic
-# platforms
-
-if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'freebsd' || 
-     ($^O eq 'solaris' && $Config{osvers} eq '2.8')
-       || ((int($]*1000) & 1) == 0)
-) {
-       skip_all('various portability issues');
-       exit 0;
+
+{
+       my $pipe;
+       my $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
+
+       my $intr = 0;
+       $SIG{ALRM} = sub { $intr = 1 };
+       alarm(1);
+
+       my $x = <$pipe>;
+
+       unless ($intr) {
+               skip_all("reads aren't interruptible");
+               exit 0;
+       }
+       alarm(0);
 }
 
+
 my ($in, $out, $st, $sigst, $buf);
 
 plan(tests => 10);