Browse files

fixed a bug in t/S32-io/IO-Socket-INET.t etc where an impatient timeout

caused random failures, mostly on slower 32 bit systems.


git-svn-id: http://svn.pugscode.org/pugs@27945 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent cac522e commit 4753f03bcc9910ce3245034baef5f11a1d078b94 mberends committed Aug 10, 2009
Showing with 11 additions and 16 deletions.
  1. +3 −1 S32-io/IO-Socket-INET.pl
  2. +5 −2 S32-io/IO-Socket-INET.sh
  3. +3 −13 S32-io/IO-Socket-INET.t
View
4 S32-io/IO-Socket-INET.pl
@@ -22,6 +22,8 @@
$server.bind( $host, int($port) );
$server.listen(); # should accept max queue size parameter
# warn "SERVER LISTENING";
+ my $fd = open( 't/spec/S32-io/server-ready-flag', :w );
+ $fd.close();
while my $client = $server.accept() {
# warn "SERVER ACCEPTED";
my $received = $client.recv();
@@ -35,7 +37,7 @@
# warn "CLIENT TEST=$test PORT=$port";
# avoid a race condition, where the client tries to
# open() before the server gets to accept().
- sleep 1; # crude, sorry
+ until 't/spec/S32-io/server-ready-flag' ~~ :e { sleep(1) }
my $client = IO::Socket::INET.new;
$client.open( $host, int($port) );
# warn "CLIENT OPENED";
View
7 S32-io/IO-Socket-INET.sh
@@ -3,7 +3,10 @@
TEST="$1"
PORT="$2"
# commented out echo lines are diagnostics used during development.
-# echo TEST=$TEST PORT=$PORT
+# echo IO-Socket-INET.sh TEST=$TEST PORT=$PORT
+
+# clear a file that acts as a status message from server to client
+rm t/spec/S32-io/server-ready-flag 2>/dev/null
# use & to run the server as a background process
./perl6 t/spec/S32-io/IO-Socket-INET.pl $TEST $PORT server & SERVER=$!
@@ -12,7 +15,7 @@ PORT="$2"
./perl6 t/spec/S32-io/IO-Socket-INET.pl $TEST $PORT client & CLIENT=$!
# make a watchdog to kill a hanging client (occurs only if a test fails)
-( sleep 10; kill $CLIENT 2>/dev/null ) &
+( sleep 20; kill $CLIENT 2>/dev/null ) &
# the client should exit after about 3 seconds. The watchdog would kill
# it after 10 sec. Hang around here until the client ends, either way.
View
16 S32-io/IO-Socket-INET.t
@@ -27,7 +27,7 @@ given $*OS {
}
# TODO: when 'Win32' etc.
}
-$received = fake_qx( $netstat_cmd ); # refactor into 1 line after
+$received = qqx{$netstat_cmd}; # refactor into 1 line after
if $received ~~ $netstat_pat { @ports = $/[]; } # development complete
#warn @ports.elems ~ " PORTS=" ~ @ports;
@@ -50,17 +50,16 @@ isa_ok $server, IO::Socket::INET;
# Do not bind to this socket in the parent process, that would prevent a
# child process from using it.
-#
if $*OS eq any <linux darwin> { # please add more valid OS names
# test 2 does echo protocol - Internet RFC 862
- $received = fake_qx( "sh t/spec/S32-io/IO-Socket-INET.sh 2 $port" );
+ $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 2 $port};
#warn "TEST 2 $received";
$expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
is $received, $expected, "echo server and client";
# test 3 does discard protocol - Internet RFC 863
- $received = fake_qx( "sh t/spec/S32-io/IO-Socket-INET.sh 3 $port" );
+ $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 3 $port};
#warn "TEST 3 $received";
$expected = "discard '' received\n";
is $received, $expected, "discard server and client";
@@ -70,15 +69,6 @@ else {
skip 1, "OS '$*OS' shell support not confirmed";
}
-# inefficient workaround - remove when Rakudo gets a qx operator
-sub fake_qx( $command ) {
- my $tempfile = "/tmp/rakudo_httpd_qx.tmp";
- my $fullcommand = "$command >$tempfile";
- run $fullcommand;
- my $result = slurp( $tempfile );
- unlink $tempfile;
- return $result;
-}
=begin pod

0 comments on commit 4753f03

Please sign in to comment.