Make http-server.t use Test::TCP
Florian Ragwitz [Wed, 2 Mar 2011 12:37:18 +0000 (13:37 +0100)]
No dep, as it's author-only and pulled in by Plack already anyway.

t/author/http-server.t

index 9754857..c90cb21 100644 (file)
@@ -5,7 +5,8 @@ use Test::More tests => 1;
 
 use File::Path;
 use FindBin;
-use IO::Socket;
+use Test::TCP;
+use Try::Tiny;
 
 use Catalyst::Devel 1.0;
 use File::Copy::Recursive;
@@ -29,19 +30,13 @@ File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die;
 rmtree '../t/tmp/TestApp/t' or die;
 
 # spawn the standalone HTTP server
-my $port = 30000 + int rand(1 + 10000);
+my $port = empty_port;
 
 my $pid = fork;
 if ($pid) {
     # parent.
     print "Waiting for server to start...\n";
-    my $timeout = 30;
-    my $count = 0;
-    while ( check_port( 'localhost', $port ) != 1 ) {
-        sleep 1;
-        die "Server did not start within $timeout seconds:"
-            if $count++ > $timeout;
-    }
+    wait_port_timeout($port, 30);
 } elsif ($pid == 0) {
     # child process
     unshift @INC, "$tmpdir/TestApp/lib", "$FindBin::Bin/../../lib";
@@ -76,21 +71,15 @@ rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";
 
 is( $return, 0, 'live tests' );
 
-sub check_port {
-    my ( $host, $port ) = @_;
-
-    my $remote = IO::Socket::INET->new(
-        Proto    => "tcp",
-        PeerAddr => $host,
-        PeerPort => $port
-    );
-    if ($remote) {
-        close $remote;
-        return 1;
-    }
-    else {
-        return 0;
+sub wait_port_timeout {
+    my ($port, $timeout) = @_;
+
+    # wait_port waits for 10 seconds
+    for (1 .. int($timeout / 10)) { # meh, good enough.
+        try { wait_port $port; 1 } and return;
     }
+
+    die "Server did not start within $timeout seconds";
 }
 
 sub prove {