print returning EINTR in 5.14 #13142
Comments
From victor@vsespb.ruTest case: #!/usr/bin/env perl use strict; local my if (my $pid = fork()) { usleep 100_000; while(wait() != -1 ){}; for (1..10) { exit(0); 1; __END__ Works fine under all perls ( Linux ), except perl-5.14 when works fine: 1..20 in 5.14: 1..20 so print returns undef + EINTR, and even if restart print operation, it possible similar issue: http://www.perlmonks.org/?node_id=1026542 I wonder if this a bug, maybe a fix should be backported, or a test case |
From @iabynOn Wed, Jul 31, 2013 at 12:30:58PM -0700, Victor Efimov wrote:
This was fixed in 5.15.4 with the following commit. It's unlikely to to commit be48bbe add a couple missing LEAVEs in perlio_async_run() -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From victor@vsespb.ruOk, what if I try to rework this poc code as test case, and submit as patch? Seems this code fails also on 5.8.x (probably different reason), and On Wed Jul 31 15:40:17 2013, davem wrote:
|
From @cpansproutOn Wed Jul 31 16:10:43 2013, vsespb wrote:
If you could, that would be much appreciated. -- Father Chrysostomos |
From victor@vsespb.rupatch attached On Wed Jul 31 17:58:23 2013, sprout wrote:
|
From victor@vsespb.ru0001-Print-and-EINTR-test.patchFrom 39e247562f389ff1f0c27913f782df0d512ccfd9 Mon Sep 17 00:00:00 2001
From: Victor <victor@vsespb.ru>
Date: Fri, 2 Aug 2013 14:39:59 +0400
Subject: [PATCH] Print and EINTR test
Test that print() is not returning EINTR,
fails under 5.14.x ( see https://rt.perl.org/rt3/Ticket/Display.html?id=119097 )
also fails under 5.8.x
Currently test enabled on linux/bsd/solaris/darwin
---
t/io/eintr_print.t | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 87 insertions(+), 0 deletions(-)
create mode 100644 t/io/eintr_print.t
diff --git a/t/io/eintr_print.t b/t/io/eintr_print.t
new file mode 100644
index 0000000..56ab5b4
--- /dev/null
+++ b/t/io/eintr_print.t
@@ -0,0 +1,87 @@
+#!./perl
+
+# print should not return EINTR
+# fails under 5.14.x see https://rt.perl.org/rt3/Ticket/Display.html?id=119097
+# also fails under 5.8.x
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use strict;
+use warnings;
+
+use Config;
+use Time::HiRes;
+use IO::Handle;
+
+require './test.pl';
+
+skip_all("only for dev versions for now") if ((int($]*1000) & 1) == 0);
+skip_all("does not match platform whitelist")
+ unless ($^O =~ /^(linux|.*bsd|darwin|solaris)$/);
+skip_all("ualarm() not implemented on this platform")
+ unless Time::HiRes::d_ualarm();
+skip_all("usleep() not implemented on this platform")
+ unless Time::HiRes::d_usleep();
+skip_all("pipe not implemented on this platform")
+ unless eval { pipe my $in, my $out; 1; };
+
+my $sample = 'abxhrtf6';
+my $full_sample = 'abxhrtf6' x (8192-7);
+my $sample_l = length $full_sample;
+
+my $ppid = $$;
+
+pipe my $in, my $out;
+
+my $small_delay = 10_000;
+my $big_delay = $small_delay * 3;
+my $fail_delay = 20_000_000;
+
+if (my $pid = fork()) {
+ plan(tests => 20);
+
+ local $SIG{ALRM} = sub { print STDERR "FAILED $$\n"; exit(1) };
+ my $child_exited = 0;
+ $in->autoflush(1);
+ $in->blocking(1);
+ binmode $in, ":perlio";
+
+ Time::HiRes::usleep $big_delay;
+
+ # in case test fail it should not hang, however this is not always helping
+ Time::HiRes::ualarm($fail_delay);
+ for (1..10) {
+ my $n = read($in, my $x, $sample_l);
+ die "EOF" unless $n;
+
+ # should return right amount of data
+ is($n, $sample_l);
+
+ # should return right data
+ # don't use "is()" as output in case of fail is big and useless
+ ok($x eq $full_sample);
+ }
+ Time::HiRes::ualarm(0);
+
+ while(wait() != -1 ){};
+} else {
+ local $SIG{ALRM} = sub { print "# ALRM $$\n" };
+ $out->autoflush(1);
+ $out->blocking(1);
+ binmode $out, ":perlio";
+
+ for (1..10) { # on some iteration print() will block
+ Time::HiRes::ualarm($small_delay); # and when it block we'll get SIGALRM
+ # it should unblock and continue after $big_delay
+ die "print failed [ $! ]" unless print($out $full_sample);
+ Time::HiRes::ualarm(0);
+ }
+
+ exit(0);
+}
+
+1;
+
--
1.7.0.4
|
From @nwc10On Fri, Aug 02, 2013 at 03:43:07AM -0700, Victor Efimov via RT wrote:
I've added the file to MANIFEST, edited the commit message slightly: commit 4a7b8c665e85a42957110900dd00dd5accaf9e46 Test that print() is not returning EINTR. MANIFEST | 1 + and pushed it to smoke-me/nicholas/rt-119097 I admit that I *haven't* actually looked closely at the code. Nicholas Clark |
From @tonycozOn Thu Aug 08 01:58:52 2013, nicholas wrote:
This test has blocked one of my darwin smokers, but doesn't appear to bash-3.2$ ps w The F is from me killing the first blockage. Running the test directly and via harness in a loop a few hundred times Tony |
From @tonycozOn Sat Aug 10 15:51:13 2013, tonyc wrote:
It also blocked on Linux amd64, Solaris 11, NetBSD 5.1.2. Tony |
From victor@vsespb.ruhm, that's sad :( i've tested it for stability like this on Linux x86-64 ( seq 10000 |xargs -P 100 -n 1 ./perl t/io/eintr_print.t ) && echo ALL_FINE (i.e. 100 concurrent runs) and it was fine. On Sat Aug 10 17:02:36 2013, tonyc wrote:
|
From victor@vsespb.ruSeems it hangs (in 100% of cases) when PERLIO=stdio can be fixed with skip_all("not supposed to work with stdio") similar code exits in eintr.t: # XXX for some reason the stdio layer doesn't seem to interrupt if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/ ) { On Sun Aug 11 01:19:12 2013, vsespb wrote:
|
From victor@vsespb.ruAlso, (1) http://perldoc.perl.org/perlipc.html#Deferred-Signals-%28Safe-Signals%29
http://perldoc.perl.org/PerlIO.html
it seems that the test initially had but PERLIO=stdio overrides this. (2) There is a ticket related to eintr.t 1. Commit http://perl5.git.perl.org/perl.git/commit/b83080de5c4254 So, according to this ticket it might be a good idea to: On Sun Aug 11 02:41:44 2013, vsespb wrote:
|
From @LeontOn Sun, Aug 11, 2013 at 3:18 PM, Victor Efimov via RT
binmode $fh, ":perlio" is conceptually nonsensical. You want to
No, it doesn't. What you're doing is effectively both: You can kind of fix it with a «use open IO => ":pop:perlio";», it Leon |
From victor@vsespb.ruok, so easier just to skip_all("not supposed to work with stdio") like eintr.t does On Sun Aug 11 05:55:55 2013, LeonT wrote:
|
From victor@vsespb.ruattaching fixes to eintr_print.t On Sun Aug 11 05:18:43 2013, vsespb wrote:
|
From victor@vsespb.ru0025-Fixing-eintr_print.t-intermittent-hang.patchFrom ea8aff5fe307d300ce2a72120f941102fe0dd016 Mon Sep 17 00:00:00 2001
From: Victor <victor@vsespb.ru>
Date: Mon, 12 Aug 2013 12:49:58 +0400
Subject: [PATCH 25/25] Fixing eintr_print.t intermittent hang
1. Disable test for PERLIO=stdio
2. Remove binmode - it turns out it's useless
3. Copy OS blacklist from eintr.t ( RT #85842, RT #84688)
4. Add additional delay before child exit, just in case.
---
t/io/eintr_print.t | 14 +++++++++++---
1 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/t/io/eintr_print.t b/t/io/eintr_print.t
index 56ab5b4..1e378fa 100644
--- a/t/io/eintr_print.t
+++ b/t/io/eintr_print.t
@@ -27,6 +27,16 @@ skip_all("usleep() not implemented on this platform")
unless Time::HiRes::d_usleep();
skip_all("pipe not implemented on this platform")
unless eval { pipe my $in, my $out; 1; };
+skip_all("not supposed to work with stdio")
+ if (defined $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/ );
+
+# copy OS blacklist from eintr.t ( related to perl #85842 and #84688 )
+my ($osmajmin) = $Config{osvers} =~ /^(\d+\.\d+)/;
+
+skip_all('various portability issues')
+ if ( $^O =~ /freebsd/ || $^O eq 'midnightbsd' ||
+ ($^O eq 'solaris' && $Config{osvers} eq '2.8') ||
+ ($^O eq 'darwin' && $osmajmin < 9) );
my $sample = 'abxhrtf6';
my $full_sample = 'abxhrtf6' x (8192-7);
@@ -47,7 +57,6 @@ if (my $pid = fork()) {
my $child_exited = 0;
$in->autoflush(1);
$in->blocking(1);
- binmode $in, ":perlio";
Time::HiRes::usleep $big_delay;
@@ -71,7 +80,6 @@ if (my $pid = fork()) {
local $SIG{ALRM} = sub { print "# ALRM $$\n" };
$out->autoflush(1);
$out->blocking(1);
- binmode $out, ":perlio";
for (1..10) { # on some iteration print() will block
Time::HiRes::ualarm($small_delay); # and when it block we'll get SIGALRM
@@ -79,7 +87,7 @@ if (my $pid = fork()) {
die "print failed [ $! ]" unless print($out $full_sample);
Time::HiRes::ualarm(0);
}
-
+ Time::HiRes::usleep(500_000);
exit(0);
}
--
1.7.0.4
|
|
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#119097 (status was 'resolved')
Searchable as RT119097$
The text was updated successfully, but these errors were encountered: