From 577a0eeb998f5bb120304f91b5a8a33bc8d3c6c7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
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ř <ppisar@redhat.com>
---
 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