X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fauthor%2Fhttp-server.t;h=2861c275ce9d12ae06c3ccc0830fa61005bf676f;hb=f6ddb2f242a1635b4a5ba848f61d87c1093422dc;hp=3bc33a0e4acea91e375aa73c8eded2a3195a7c1b;hpb=876db346c24d0016c70a281a57e4696e81abe8fe;p=catagits%2FCatalyst-Runtime.git diff --git a/t/author/http-server.t b/t/author/http-server.t index 3bc33a0..2861c27 100644 --- a/t/author/http-server.t +++ b/t/author/http-server.t @@ -2,15 +2,23 @@ use strict; use warnings; use Test::More tests => 1; +use Test::TCP; use File::Path; use FindBin; -use Test::TCP; +use Net::EmptyPort qw(wait_port empty_port); use Try::Tiny; use Plack::Builder; -use Catalyst::Devel 1.0; -use File::Copy::Recursive; +eval { require Catalyst::Devel; Catalyst::Devel->VERSION(1.0); 1; } || do { + fail("Could not load Catalyst::Devel: $@"); + exit 1; +}; + +eval { require File::Copy::Recursive; 1 } || do { + fail("Could not load File::Copy::Recursive: $@"); + exit 1; +}; # Run a single test by providing it as the first arg my $single_test = shift; @@ -43,7 +51,7 @@ if ($pid) { unshift @INC, "$tmpdir/TestApp/lib", "$FindBin::Bin/../../lib"; require TestApp; - my $psgi_app = TestApp->_wrapped_legacy_psgi_app(TestApp->psgi_app); + my $psgi_app = TestApp->apply_default_middlewares(TestApp->psgi_app); Plack::Loader->auto(port => $port)->run(builder { mount '/test_prefix' => $psgi_app; mount '/' => sub { @@ -77,13 +85,19 @@ rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; is( $return, 0, 'live tests' ); +# kill 'INT' doesn't exist in Windows, so to prevent child hanging, +# this process will need to commit seppuku to clean up the children. +if ($^O eq 'MSWin32') { + # Furthermore, it needs to do it 'politely' so that TAP doesn't + # smell anything 'dubious'. + require Win32::Process; # core in all versions of Win32 Perl + Win32::Process::KillProcess($$, $return); +} + 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; - } + wait_port($port, $timeout * 10) and return; die "Server did not start within $timeout seconds"; }