| Subject: | Failure of t/10_loops/04_drivers/01_sysrw.t on Win32 (v1_310-47-gaf6b204) |
The commit >> 322bb80a55c74b2918bc << [1] which tried to simplify the
implementation of nonblocking() causes the test to fail (or simply wait
forever, due to a bug in write_until_pipe_full) on Win32.
The problem is that the code that implements IO::Handle::blocking() on
Win32 is completely wrong (see Perl bug #95586). blocking(0) turns ON
blocking, blocking(1) turns OFF blocking.
Fortunately, there is a completely portable workaround: blocking(),
which normally returns the blocking status, turns OFF blocking on Win32.
System information:
POE: v1_310-47-gaf6b204 (9bcbb9098bf12139b4f80ef96650eafba3e1d95b)
perl -v: This is perl 5, version 14, subversion 1 (v5.14.1) built for
MSWin32-x64-multi-thread [ActivePerl]
OS: Windows 2003 Server 64-bit Standard Edition
| Subject: | poe-sysrw-win32-testfix.patch |
diff --git a/t/10_units/04_drivers/01_sysrw.t b/t/10_units/04_drivers/01_sysrw.t
index ee709cc..6f50b7e 100644
--- a/t/10_units/04_drivers/01_sysrw.t
+++ b/t/10_units/04_drivers/01_sysrw.t
@@ -3,7 +3,7 @@
use strict;
-use Test::More tests => 17;
+use Test::More tests => 18;
use POE::Pipe::OneWay;
BEGIN { use_ok("POE::Driver::SysRW") }
@@ -106,9 +106,11 @@ nonblocking($r);
# Number of flushed octets == number of read octets.
-{ my $flushed_count = write_until_pipe_is_full($d, $w);
- my $read_count = read_until_pipe_is_empty($d, $r);
+{ my ($flushed_count, $full) = write_until_pipe_is_full($d, $w);
+ my ($read_count) = read_until_pipe_is_empty($d, $r);
+ ok($full, "data successfully written");
+
ok(
$flushed_count == $read_count,
"flushed $flushed_count octets == read $read_count octets"
@@ -185,14 +187,19 @@ sub write_until_pipe_is_full {
# Try to flush it.
my $after_flush = $driver->flush($handle);
+
+ $full = 1 if defined($after_flush) && $after_flush == 0;
# Flushed amount.
$flushed += $buffered - $after_flush;
# The pipe is full if there's data after the flush.
- last if $after_flush;
+ last if !defined($after_flush) || $after_flush;
}
+ if (wantarray) {
+ return ($flushed, $full);
+ }
return $flushed;
}
@@ -245,7 +252,7 @@ sub nonblocking {
eval { binmode *$handle };
# Turn off blocking.
- eval { $handle->blocking(0) };
+ eval { $handle->blocking(0); $handle->blocking(); };
# Turn off buffering.
CORE::select((CORE::select($handle), $| = 1)[0]);