From 577a0eeb998f5bb120304f91b5a8a33bc8d3c6c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Fri, 4 Mar 2016 15:04:48 +0100 Subject: [PATCH] Fix a race in t/read-write.t test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit There was a race between filling a write buffer and testing a subsequent write would block. This patch fills the buffer first, and then it tests the blocking. CPAN RT#95702 Signed-off-by: Petr Písař --- t/read-write.t | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/t/read-write.t b/t/read-write.t index 21fe729..03c0bc0 100644 --- a/t/read-write.t +++ b/t/read-write.t @@ -12,17 +12,15 @@ like($pty->read, qr/testing/, "basic read/write testing"); is($pty->read(0.1), undef, "read returns undef on timeout"); $pty->kill; -$pty->spawn("$^X -e 'sleep(1) while 1'"); -eval { - local $SIG{ALRM} = sub { - is($pty->write("should fail", 0.1), undef, - "write returns undef on timeout"); - $SIG{ALRM} = 'DEFAULT'; - alarm 1; - }; - alarm 1; - $pty->write('a'x(1024*1024)); +ok($pty->spawn("$^X -e 'print qq{start\n}; sleep(1) while 1'"), + 'Program spawned'); +ok($pty->read, 'Program is ready'); +my $ret; +while (defined ($ret = $pty->write('a' x 1024, 1))) { + diag("Filling write buffer: +$ret"); }; +diag "Writte buffer filled"; +is($pty->write("should fail", 0.1), undef, "write returns undef on timeout"); $pty->kill; $pty->close; -- 2.5.0