Stop remote tests breaking everything, and force authors to run some remote tests.
Tomas Doran [Tue, 1 Sep 2009 01:10:46 +0000 (01:10 +0000)]
t/aggregate/live_component_controller_action_index_or_default.t
t/aggregate/live_component_controller_action_path_matchsingle.t
t/aggregate/live_component_controller_action_regexp.t
t/aggregate/live_component_view_single.t
t/aggregate/live_engine_request_remote_user.t
t/author/optional_http-server.t [moved from t/optional_http-server.t with 61% similarity]
t/lib/TestApp.pm
t/optional_http-server-restart.t
t/unit_core_classdata.t

index e10d6d2..ea5d2c3 100644 (file)
@@ -10,10 +10,13 @@ our $iters;
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 6*$iters;
-
+use Test::More;
 use Catalyst::Test 'TestAppIndexDefault';
 
+plan 'skip_all' if ( $ENV{CATALYST_SERVER} );
+
+plan tests => 6*$iters;
+
 if ( $ENV{CAT_BENCHMARK} ) {
     require Benchmark;
     Benchmark::timethis( $iters, \&run_tests );
index 34ad404..beced91 100644 (file)
@@ -10,9 +10,13 @@ our $iters;
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 3*$iters;
+use Test::More;
 use Catalyst::Test 'TestAppMatchSingleArg';
 
+plan 'skip_all' if ( $ENV{CATALYST_SERVER} );
+
+plan tests => 3*$iters;
+
 if ( $ENV{CAT_BENCHMARK} ) {
     require Benchmark;
     Benchmark::timethis( $iters, \&run_tests );
index 2697940..36a679e 100644 (file)
@@ -131,8 +131,10 @@ sub run_tests {
             'TestApp::Controller::Action::Regexp',
             'Test Class'
         );
+        my $location = $response->header('location');
+        $location =~ s/localhost(:\d+)?/localhost/;
         is(
-            $response->header('location'),
+            $location,
             $url,
             'Redirect URI is the same as the request URI'
         );
index 9396ffb..15924cd 100644 (file)
@@ -10,9 +10,13 @@ our $iters;
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 3*$iters;
+use Test::More;
 use Catalyst::Test 'TestAppOneView';
 
+plan 'skip_all' if ( $ENV{CATALYST_SERVER} );
+
+plan tests => 3*$iters;
+
 if ( $ENV{CAT_BENCHMARK} ) {
     require Benchmark;
     Benchmark::timethis( $iters, \&run_tests );
index 10b071b..7e5cba2 100644 (file)
@@ -37,6 +37,11 @@ use HTTP::Request::Common;
     }
 
     isa_ok( $creq, 'Catalyst::Request' );
-    
-    is( $creq->remote_user, 'dwc', '$c->req->remote_user ok' );
+    SKIP:
+    {
+        if ( $ENV{CATALYST_SERVER} ) {
+            skip 'Using remote server', 1;
+        }
+        is( $creq->remote_user, 'dwc', '$c->req->remote_user ok' );
+    }
 }
similarity index 61%
rename from t/optional_http-server.t
rename to t/author/optional_http-server.t
index 60f9259..d4a2183 100644 (file)
@@ -1,26 +1,20 @@
 use strict;
 use warnings;
 
-use Test::More;
-BEGIN {
-    plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
-}
+use Test::More tests => 1;
 
 use File::Path;
 use FindBin;
 use IPC::Open3;
 use IO::Socket;
 
-eval "use Catalyst::Devel 1.0";
-plan skip_all => 'Catalyst::Devel required' if $@;
-eval "use File::Copy::Recursive";
-plan skip_all => 'File::Copy::Recursive required' if $@;
-plan tests => 1;
+use Catalyst::Devel 1.0;
+use File::Copy::Recursive;
 
 # Run a single test by providing it as the first arg
 my $single_test = shift;
 
-my $tmpdir = "$FindBin::Bin/../t/tmp";
+my $tmpdir = "$FindBin::Bin/../../t/tmp";
 
 # clean up
 rmtree $tmpdir if -d $tmpdir;
@@ -28,24 +22,28 @@ rmtree $tmpdir if -d $tmpdir;
 # create a TestApp and copy the test libs into it
 mkdir $tmpdir;
 chdir $tmpdir;
-system( $^X, "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' );
+system( $^X, "-I$FindBin::Bin/../../lib", "$FindBin::Bin/../../script/catalyst.pl", 'TestApp' );
 chdir "$FindBin::Bin/..";
-File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
+File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die;
 
 # remove TestApp's tests
-rmtree 't/tmp/TestApp/t';
+rmtree '../t/tmp/TestApp/t' or die;
 
 # spawn the standalone HTTP server
 my $port = 30000 + int rand(1 + 10000);
-my $pid = open3( undef, my $server, undef,
-  $^X, "-I$FindBin::Bin/../lib",
-  "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', $port )
+my @cmd = ($^X, "-I$FindBin::Bin/../../lib",
+  "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '-port', $port );
+my $pid = open3( undef, my $server, undef, @cmd)
     or die "Unable to spawn standalone HTTP server: $!";
 
 # wait for it to start
 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: " . join(' ', @cmd))
+        if $count++ > $timeout;
 }
 
 # run the testsuite against the HTTP server
@@ -53,10 +51,10 @@ $ENV{CATALYST_SERVER} = "http://localhost:$port";
 
 my $return;
 if ( $single_test ) {
-    $return = system( "$^X -Ilib/ $single_test" );
+    $return = system( "$^X -I../lib/ $single_test" );
 }
 else {
-    $return = prove( '-r', '-Ilib/', glob('t/aggregate/live_*.t') );
+    $return = prove( '-r', '-I../lib/', glob('../t/aggregate/live_*.t') );
 }
 
 # shut it down
@@ -64,7 +62,7 @@ kill 'INT', $pid;
 close $server;
 
 # clean up
-rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";
 
 is( $return, 0, 'live tests' );
 
index e14e3dc..321f78e 100644 (file)
@@ -77,7 +77,7 @@ sub execute {
             @executed
         );
     }
-
+    no warnings 'recursion';
     return $c->SUPER::execute(@_);
 }
 
@@ -107,6 +107,7 @@ sub loop_test : Local {
 
 sub recursion_test : Local {
     my ( $self, $c ) = @_;
+    no warnings 'recursion';
     $c->forward( 'recursion_test' );
 }
 
index 39f475a..3d3cb3f 100644 (file)
@@ -45,10 +45,11 @@ rmtree 't/tmp/TestApp/t';
 my $port = 30000 + int rand( 1 + 10000 );
 
 my( $server, $pid );
-$pid = open3( undef, $server, undef,
-  $^X, "-I$FindBin::Bin/../lib",
+my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib",
   "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
-  $port, '-restart' )
+  $port, '-restart');
+
+$pid = open3( undef, $server, undef, @cmd )
     or die "Unable to spawn standalone HTTP server: $!";
 
 # switch to non-blocking reads so we can fail
@@ -67,11 +68,9 @@ my @files = (
     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm",
+    "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm",
 );
 
-push(@files, "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm")
-    if Catalyst::Engine::HTTP::Restarter::Watcher::DETECT_PACKAGE_COMPILATION();
-
 # change some files and make sure the server restarts itself
 NON_ERROR_RESTART:
 for ( 1 .. 20 ) {
@@ -84,7 +83,6 @@ for ( 1 .. 20 ) {
     # give the server time to notice the change and restart
     my $count = 0;
     my $line;
-
     while ( ( $line || '' ) !~ /can connect/ ) {
         # wait for restart message
         $line = $server->getline;
index 6d60a96..d054dc6 100644 (file)
@@ -100,3 +100,7 @@ is(refaddr(ClassDataTest->_hashref), refaddr($hashref3));
 is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3));
 is(refaddr(ClassDataTest->_coderef), refaddr($coderef3));
 is(ClassDataTest->_scalar, $scalar3);
+
+my $i = bless {}, 'ClassDataTest';
+$i->_scalar('foo');
+