summaryrefslogtreecommitdiffstats
path: root/t/02-read-write.t
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-04-14 04:01:07 -0500
committerJesse Luehrs <doy@tozt.net>2011-04-14 04:01:07 -0500
commite9a81b456202679d408f13910c9a2a0ff5eac973 (patch)
tree6e16181d18540c10828579f5f543bee9da260664 /t/02-read-write.t
parentf0ff57fc713d7b9ae8edc9002d6afa8aa89196ef (diff)
downloadapp-termcast-e9a81b456202679d408f13910c9a2a0ff5eac973.tar.gz
app-termcast-e9a81b456202679d408f13910c9a2a0ff5eac973.zip
make the tests a bit more reliable
there are probably still race conditions here (this is pretty hacky in general), but it's miles better than "sleep", so we'll go with it for now.
Diffstat (limited to 't/02-read-write.t')
-rw-r--r--t/02-read-write.t49
1 files changed, 41 insertions, 8 deletions
diff --git a/t/02-read-write.t b/t/02-read-write.t
index a970ddd..b7a26ac 100644
--- a/t/02-read-write.t
+++ b/t/02-read-write.t
@@ -7,9 +7,15 @@ use IO::Pty::Easy;
use App::Termcast;
+pipe(my $cread, my $swrite);
+pipe(my $sread, my $cwrite);
+
test_tcp(
client => sub {
my $port = shift;
+ close $swrite;
+ close $sread;
+ { sysread($cread, my $buf, 1) }
my $inc = join ':', grep { !ref } @INC;
my $client_script = <<EOF;
BEGIN { \@INC = split /:/, '$inc' }
@@ -17,42 +23,69 @@ test_tcp(
my \$tc = App::Termcast->new(
host => '127.0.0.1', port => $port,
user => 'test', password => 'tset');
- \$tc->run('$^X', "-e", "while (<>) { last if /\\\\./; print }");
+ \$tc->run('$^X', "-e", "while (<>) { last if /\\\\./; print; print qq{---\\n}; }");
EOF
my $pty = IO::Pty::Easy->new;
$pty->spawn("$^X", "-e", $client_script);
+ syswrite($cwrite, 'a');
+ { sysread($cread, my $buf, 1) }
$pty->write("foo\n");
- sleep 1; # give the subprocess time to generate its output
- is($pty->read, "foo\r\nfoo\r\n", 'got the right thing on stdout');
+ syswrite($cwrite, 'a');
+ { sysread($cread, my $buf, 1) }
+ {
+ local $SIG{ALRM} = sub { fail("got the right thing on stdout") };
+ alarm 10;
+ my $read = '';
+ $read .= $pty->read until $read =~ /---/;
+ alarm 0;
+ is($read, "foo\r\nfoo\r\n---\r\n", 'got the right thing on stdout');
+ }
$pty->write("bar\n");
- sleep 1; # give the subprocess time to generate its output
- is($pty->read, "bar\r\nbar\r\n", 'got the right thing on stdout');
+ syswrite($cwrite, 'a');
+ { sysread($cread, my $buf, 1) }
+ {
+ local $SIG{ALRM} = sub { fail("got the right thing on stdout") };
+ alarm 10;
+ my $read = '';
+ $read .= $pty->read until $read =~ /---/;
+ alarm 0;
+ is($read, "bar\r\nbar\r\n---\r\n", 'got the right thing on stdout');
+ }
$pty->write(".\n");
+ syswrite($cwrite, 'a');
+ { sysread($cread, my $buf, 1) }
is($pty->read, ".\r\n", "didn't get too much data");
- sleep 1; # because the server gets killed when the client exits
},
server => sub {
my $port = shift;
+ close $cwrite;
+ close $cread;
my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
LocalPort => $port,
Listen => 1);
$sock->accept; # signal to the client that the port is available
+ syswrite($swrite, 'a');
my $client = $sock->accept;
+ { sysread($sread, my $buf, 1) }
my $login;
$client->recv($login, 4096);
- my $auth_regexp = qr/^hello test tset\n\e\[H\x00.+?\xff\e\[H\e\[2J/;
+ my $auth_regexp = qr/^hello test tset\n(?:\e\[H\x00.+?\xff\e\[H\e\[2J)?/;
like($login, $auth_regexp, 'got the correct login info');
$client->send("hello, test\n");
+ syswrite($swrite, 'a');
my $output;
my $total_out = '';
while (1) {
+ { sysread($sread, my $buf, 1) }
$client->recv($output, 4096);
last unless defined($output) && length($output);
$total_out .= $output;
+ syswrite($swrite, 'a');
}
- is($total_out, "foo\r\nfoo\r\nbar\r\nbar\r\n.\r\n",
+ is($total_out, "foo\r\nfoo\r\n---\r\nbar\r\nbar\r\n---\r\n.\r\n",
'sent the right data to the server');
+ syswrite($swrite, 'a');
},
);