From f9005e892729261fb9c10d370f161fa1f4fd7393 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 7 Mar 2012 03:00:03 -0600
Subject: few more tweaks to make these tests more reliable

---
 t/basic.t     | 47 +++++++++++++++++++++++++++++++++++++++--------
 t/callbacks.t |  9 ++++++---
 t/extra-pty.t | 54 +++++++++++++++++++++++++++++++++++++-----------------
 t/role.t      |  9 ++++++---
 4 files changed, 88 insertions(+), 31 deletions(-)

diff --git a/t/basic.t b/t/basic.t
index 4c72512..ae51826 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -4,6 +4,7 @@ use warnings;
 use Test::More;
 
 use IO::Pty::Easy;
+use IO::Select;
 
 my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
 
@@ -24,15 +25,45 @@ $pty->spawn($^X, (map {; '-I', $_ } @INC), '-e', $script);
 alarm 60;
 
 $pty->write("foo\n");
-is($pty->read(undef, 5), "foo$crlf");
-is($pty->read(undef, 5), "foo$crlf");
+is(full_read($pty), "foo${crlf}foo${crlf}");
 $pty->write("bar\nbaz\n");
-is($pty->read(undef, 5), "bar$crlf");
-is($pty->read(undef, 5), "baz$crlf");
-is($pty->read(undef, 5), "bar$crlf");
-is($pty->read(undef, 5), "baz$crlf");
+like(
+    full_read($pty),
+    qr{
+        ^
+        bar \Q$crlf\E
+        (?:
+            bar \Q$crlf\E
+            baz \Q$crlf\E
+        |
+            baz \Q$crlf\E
+            bar \Q$crlf\E
+        )
+        baz \Q$crlf\E
+        $
+    }mx,
+);
 $pty->write("\n");
-is($pty->read(undef, 2), "$crlf");
-is($pty->read(undef, 6), "done\n");
+is(full_read($pty), "${crlf}done\n");
+
+sub full_read {
+    my ($fh) = @_;
+
+    my $select = IO::Select->new($fh);
+    return if $select->has_exception(0.1);
+
+    1 while !$select->can_read(1);
+
+    my $ret;
+    while ($select->can_read(1)) {
+        my $new;
+        sysread($fh, $new, 4096);
+        last unless defined($new) && length($new);
+        $ret .= $new;
+        return $ret if $select->has_exception(0.1);
+    }
+
+    return $ret;
+}
 
 done_testing;
diff --git a/t/callbacks.t b/t/callbacks.t
index 250fec7..5a8f17d 100644
--- a/t/callbacks.t
+++ b/t/callbacks.t
@@ -111,14 +111,17 @@ alarm 60;
 }
 
 sub full_read {
-    my ($pty) = @_;
+    my ($fh) = @_;
 
-    my $select = IO::Select->new($pty);
+    my $select = IO::Select->new($fh);
     return if $select->has_exception(0.1);
 
+    1 while !$select->can_read(1);
+
     my $ret;
     while ($select->can_read(1)) {
-        my $new = $pty->read;
+        my $new;
+        sysread($fh, $new, 4096);
         last unless defined($new) && length($new);
         $ret .= $new;
         return $ret if $select->has_exception(0.1);
diff --git a/t/extra-pty.t b/t/extra-pty.t
index 8393f4f..1e7210a 100644
--- a/t/extra-pty.t
+++ b/t/extra-pty.t
@@ -37,10 +37,10 @@ my \$term = Term::Filter::Callback->new(
                 my \$buf;
                 sysread(\$fh, \$buf, 4096);
                 if (defined(\$buf) && length(\$buf)) {
-                    print "read from pipe: \$buf\\n";
+                    print "1read from pipe: \$buf\\n";
                 }
                 else {
-                    print "pipe error (read)!\\n";
+                    print "2pipe error (read)!\\n";
                     \$t->remove_input_handle(\$readfh);
                 }
             }
@@ -48,19 +48,19 @@ my \$term = Term::Filter::Callback->new(
         read_error => sub {
             my (\$t, \$fh) = \@_;
             if (\$fh == \$readfh) {
-                print "pipe error (exception)!\\n";
+                print "3pipe error (exception)!\\n";
                 \$t->remove_input_handle(\$readfh);
             }
         },
         munge_output => sub {
             my (\$t, \$buf) = \@_;
-            syswrite(\$writefh, "read from term: \$buf");
+            syswrite(\$writefh, "4read from term: \$buf");
             \$buf;
         },
     }
 );
 \$term->run(\$^X, '-ple', q[last if /^\$/]);
-print "done\\n";
+print "5done\\n";
 SCRIPT
 
 my $crlf = "\x0d\x0a";
@@ -79,28 +79,48 @@ alarm 60;
 
     $pty->write("foo\n");
 
-    is($pty->read(undef, 5), "foo$crlf");
-    is($pty->read(undef, 5), "foo$crlf");
+    is(full_read($pty), "foo${crlf}foo${crlf}");
 
     {
-        my $buf;
-        sysread($writefh, $buf, 21);
-        is($buf, "read from term: foo$crlf");
-        sysread($writefh, $buf, 21);
-        # note that this could either happen as a second write, or as part
-        # of the first write (in which case, this read finishes reading
-        # the rest of the data that was sent previously)
-        like($buf, qr/^(?:read from term: )?foo\Q$crlf\E$/);
+        my $got_pipe = full_read($writefh);
+        like($got_pipe, qr/4read from term: /);
+        $got_pipe =~ s/4read from term: //g;
+        is($got_pipe, "foo${crlf}foo${crlf}");
     }
 
     syswrite($readfh, "bar");
 
-    is($pty->read(undef, 21), "read from pipe: bar\n");
+    {
+        my $got_pty = full_read($pty);
+        like($got_pty, qr/1read from pipe: /);
+        $got_pty =~ s/1read from pipe: //g;
+        is($got_pty, "bar\n");
+    }
 
     close($readfh);
     close($writefh);
 
-    is($pty->read(undef, 19), "pipe error (read)!\n");
+    is(full_read($pty), "2pipe error (read)!\n");
+}
+
+sub full_read {
+    my ($fh) = @_;
+
+    my $select = IO::Select->new($fh);
+    return if $select->has_exception(0.1);
+
+    1 while !$select->can_read(1);
+
+    my $ret;
+    while ($select->can_read(1)) {
+        my $new;
+        sysread($fh, $new, 4096);
+        last unless defined($new) && length($new);
+        $ret .= $new;
+        return $ret if $select->has_exception(0.1);
+    }
+
+    return $ret;
 }
 
 done_testing;
diff --git a/t/role.t b/t/role.t
index 25cfec0..1c3c9b0 100644
--- a/t/role.t
+++ b/t/role.t
@@ -120,14 +120,17 @@ alarm 60;
 }
 
 sub full_read {
-    my ($pty) = @_;
+    my ($fh) = @_;
 
-    my $select = IO::Select->new($pty);
+    my $select = IO::Select->new($fh);
     return if $select->has_exception(0.1);
 
+    1 while !$select->can_read(1);
+
     my $ret;
     while ($select->can_read(1)) {
-        my $new = $pty->read;
+        my $new;
+        sysread($fh, $new, 4096);
         last unless defined($new) && length($new);
         $ret .= $new;
         return $ret if $select->has_exception(0.1);
-- 
cgit v1.2.3