diff options
author | Jesse Luehrs <doy@tozt.net> | 2011-04-14 04:01:07 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2011-04-14 04:01:07 -0500 |
commit | e9a81b456202679d408f13910c9a2a0ff5eac973 (patch) | |
tree | 6e16181d18540c10828579f5f543bee9da260664 /t/02-read-write.t | |
parent | f0ff57fc713d7b9ae8edc9002d6afa8aa89196ef (diff) | |
download | app-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.t | 49 |
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'); }, ); |