summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-03-07 04:03:12 -0600
committerJesse Luehrs <doy@tozt.net>2012-03-07 04:03:12 -0600
commit1da7bb9fec584f750af45443bfd55a65daf123bf (patch)
tree442403a6986560fa3504a76de18235c2f95d8851
parent8400a644856ef47124129b34128d9cea91262d69 (diff)
downloadapp-termcast-1da7bb9fec584f750af45443bfd55a65daf123bf.tar.gz
app-termcast-1da7bb9fec584f750af45443bfd55a65daf123bf.zip
more reliable tests
-rw-r--r--t/basic.t49
-rw-r--r--t/read-write.t78
-rw-r--r--t/write-to-termcast.t38
3 files changed, 114 insertions, 51 deletions
diff --git a/t/basic.t b/t/basic.t
index f4f6b49..d913fec 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -4,35 +4,41 @@ use warnings;
use Test::More;
use Test::Requires 'Test::TCP', 'IO::Pty::Easy';
+use IO::Select;
+
use App::Termcast;
pipe(my $cread, my $swrite);
pipe(my $sread, my $cwrite);
+alarm 60;
+
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' }
use App::Termcast;
no warnings 'redefine';
local *App::Termcast::_termsize = sub { return (80, 24) };
use warnings 'redefine';
- my \$tc = App::Termcast->new(host => '127.0.0.1', port => $port,
- user => 'test', password => 'tset');
- \$tc->run('$^X', "-e", "print 'foo'");
+ my \$tc = App::Termcast->new(
+ host => '127.0.0.1',
+ port => $port,
+ user => 'test',
+ password => 'tset',
+ );
+ \$tc->run(\$^X, '-e', "print 'foo'");
EOF
my $pty = IO::Pty::Easy->new;
- $pty->spawn("$^X", "-e", $client_script);
+ $pty->spawn($^X, (map {; '-I', $_ } @INC), '-e', $client_script);
syswrite($cwrite, 'a');
{ sysread($cread, my $buf, 1) }
- is($pty->read, 'foo', 'got the right thing on stdout');
+ is(full_read($pty), 'foo', 'got the right thing on stdout');
},
server => sub {
my $port = shift;
@@ -45,17 +51,34 @@ EOF
syswrite($swrite, 'a');
my $client = $sock->accept;
{ sysread($sread, my $buf, 1) }
- my $login;
- $client->recv($login, 4096);
- is($login,
+ is(full_read($client),
"hello test tset\n\e\[H\x00{\"geometry\":[80,24]}\xff\e\[H\e\[2J",
"got the correct login info");
$client->send("hello, test\n");
- my $output;
- $client->recv($output, 4096);
- is($output, "foo", 'sent the right data to the server');
+ is(full_read($client), "foo");
syswrite($swrite, 'a');
+ sleep 1 while $client->connected;
},
);
+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/read-write.t b/t/read-write.t
index fa5145b..52ed8e9 100644
--- a/t/read-write.t
+++ b/t/read-write.t
@@ -9,15 +9,20 @@ use App::Termcast;
pipe(my $cread, my $swrite);
pipe(my $sread, my $cwrite);
+alarm 60;
+
+my $crlf = "\x0d\x0a";
+
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' }
use App::Termcast;
no warnings 'redefine';
@@ -25,40 +30,35 @@ test_tcp(
use warnings 'redefine';
my \$tc = App::Termcast->new(
- host => '127.0.0.1', port => $port,
- user => 'test', password => 'tset');
- \$tc->run('$^X', "-e", "while (<>) { last if /\\\\./; print; print qq{---\\n}; }");
+ host => '127.0.0.1',
+ port => $port,
+ user => 'test',
+ password => 'tset',
+ );
+ \$tc->run(\$^X, '-ple', q[last if /^\$/]);
EOF
my $pty = IO::Pty::Easy->new;
- $pty->spawn("$^X", "-e", $client_script);
+ $pty->spawn($^X, (map {; '-I', $_ } @INC), '-e', $client_script);
syswrite($cwrite, 'a');
{ sysread($cread, my $buf, 1) }
+
$pty->write("foo\n");
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');
- }
+
+ is(full_read($pty), "foo${crlf}foo${crlf}");
+
$pty->write("bar\n");
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");
+
+ is(full_read($pty), "bar${crlf}bar${crlf}");
+
+ $pty->write("\n");
syswrite($cwrite, 'a');
{ sysread($cread, my $buf, 1) }
- is($pty->read, ".\r\n", "didn't get too much data");
+
+ is(full_read($pty), "$crlf");
},
server => sub {
my $port = shift;
@@ -71,27 +71,45 @@ EOF
syswrite($swrite, 'a');
my $client = $sock->accept;
{ sysread($sread, my $buf, 1) }
- my $login;
- $client->recv($login, 4096);
- is($login,
+ is(full_read($client),
"hello test tset\n\e\[H\x00{\"geometry\":[80,24]}\xff\e\[H\e\[2J",
"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);
+ my $output = full_read($client);
last unless defined($output) && length($output);
$total_out .= $output;
syswrite($swrite, 'a');
}
- is($total_out, "foo\r\nfoo\r\n---\r\nbar\r\nbar\r\n---\r\n.\r\n",
+ is($total_out, "foo${crlf}foo${crlf}bar${crlf}bar${crlf}${crlf}",
'sent the right data to the server');
syswrite($swrite, 'a');
+ sleep 1 while $client->connected;
},
);
+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/write-to-termcast.t b/t/write-to-termcast.t
index 8a5ed1b..2be2c36 100644
--- a/t/write-to-termcast.t
+++ b/t/write-to-termcast.t
@@ -13,6 +13,8 @@ use warnings 'redefine';
pipe(my $cread, my $swrite);
pipe(my $sread, my $cwrite);
+alarm 60;
+
test_tcp(
client => sub {
my $port = shift;
@@ -20,8 +22,11 @@ test_tcp(
close $sread;
{ sysread($cread, my $buf, 1) }
my $tc = App::Termcast->new(
- host => '127.0.0.1', port => $port,
- user => 'test', password => 'tset');
+ host => '127.0.0.1',
+ port => $port,
+ user => 'test',
+ password => 'tset',
+ );
$tc->write_to_termcast('foo');
syswrite($cwrite, 'a');
{ sysread($cread, my $buf, 1) }
@@ -38,19 +43,36 @@ test_tcp(
$sock->accept; # signal to the client that the port is available
syswrite($swrite, 'a');
my $client = $sock->accept;
- my $login;
- $client->recv($login, 4096);
- is($login,
+ is(full_read($client),
"hello test tset\n\e\[H\x00{\"geometry\":[80,24]}\xff\e\[H\e\[2J",
"got the correct login info");
$client->send("hello, test\n");
{ sysread($sread, my $buf, 1) }
- my $buf;
- $client->recv($buf, 4096);
- is($buf, 'foo', 'wrote correctly');
+ is(full_read($client), "foo");
syswrite($swrite, 'a');
+ sleep 1 while $client->connected;
},
);
+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;