From 577a0eeb998f5bb120304f91b5a8a33bc8d3c6c7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <
[email protected]>
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ř <
[email protected]>
---
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
