From d4bcc9ec0f929a76b02291efe94730889b3f349b Mon Sep 17 00:00:00 2001
From: doy <doy@tozt.net>
Date: Thu, 5 Feb 2009 00:18:48 -0500
Subject: add a couple tests for write(), some failing

---
 t/010-read-write.t | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

(limited to 't')

diff --git a/t/010-read-write.t b/t/010-read-write.t
index 7cd0ada..80f5f1e 100644
--- a/t/010-read-write.t
+++ b/t/010-read-write.t
@@ -1,7 +1,7 @@
 #!perl
 use strict;
 use warnings;
-use Test::More tests => 2;
+use Test::More tests => 5;
 use IO::Pty::Easy;
 
 my $pty = IO::Pty::Easy->new;
@@ -10,6 +10,38 @@ $pty->spawn("$^X -ple ''");
 $pty->write("testing\n");
 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));
+};
+$pty->kill;
+$pty->close;
+
+# create an entirely new pty to clear the input buffer
+$pty = IO::Pty::Easy->new;
+$pty->spawn("$^X -e 'sleep(1) while 1'");
+my $result = "wrong";
+$result = eval {
+    local $SIG{ALRM} = sub { die "alarm\n" };
+    alarm 2;
+    my $write_result = $pty->write('a'x(1024*1024), 0.1);
+    defined($write_result) ? "wrong" : "right";
+};
+TODO: {
+    local $TODO = "need to figure this one out";
+    is($result, "right", "write times out properly even on the first call");
+    isnt($@, "alarm\n", "write times out properly even on the first call");
+}
+
 # if the perl script ends with a subprocess still running, the test will exit
 # with the exit status of the signal that the subprocess dies with, so we have
 # to kill the subprocess before exiting.
-- 
cgit v1.2.3-54-g00ecf