Commit | Line | Data |
ceae39c5 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More tests => 1; |
5 | |
6 | use File::Path; |
7 | use FindBin; |
8 | use IPC::Open3; |
9 | use IO::Socket; |
10 | |
11 | use Catalyst::Devel 1.0; |
12 | use File::Copy::Recursive; |
13 | |
14 | # Run a single test by providing it as the first arg |
15 | my $single_test = shift; |
16 | |
17 | my $tmpdir = "$FindBin::Bin/../../t/tmp"; |
18 | |
19 | # clean up |
20 | rmtree $tmpdir if -d $tmpdir; |
21 | |
22 | # create a TestApp and copy the test libs into it |
23 | mkdir $tmpdir; |
24 | chdir $tmpdir; |
25 | system( $^X, "-I$FindBin::Bin/../../lib", "$FindBin::Bin/../../script/catalyst.pl", 'TestApp' ); |
26 | chdir "$FindBin::Bin/.."; |
27 | File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die; |
28 | |
29 | # remove TestApp's tests |
30 | rmtree '../t/tmp/TestApp/t' or die; |
31 | |
32 | # spawn the standalone HTTP server |
33 | my $port = 30000 + int rand(1 + 10000); |
34 | my @cmd = ($^X, "-I$FindBin::Bin/../../lib", |
35 | "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '-port', $port ); |
36 | my $pid = open3( undef, my $server, undef, @cmd) |
37 | or die "Unable to spawn standalone HTTP server: $!"; |
38 | |
39 | # wait for it to start |
40 | print "Waiting for server to start...\n"; |
41 | my $timeout = 30; |
42 | my $count = 0; |
43 | while ( check_port( 'localhost', $port ) != 1 ) { |
44 | sleep 1; |
45 | die("Server did not start within $timeout seconds: " . join(' ', @cmd)) |
46 | if $count++ > $timeout; |
47 | } |
48 | |
49 | # run the testsuite against the HTTP server |
50 | $ENV{CATALYST_SERVER} = "http://localhost:$port"; |
51 | |
52 | my $return; |
53 | if ( $single_test ) { |
54 | $return = system( "$^X -I../lib/ $single_test" ); |
55 | } |
56 | else { |
57 | $return = prove( '-r', '-I../lib/', glob('../t/aggregate/live_*.t') ); |
58 | } |
59 | |
60 | # shut it down |
61 | kill 'INT', $pid; |
62 | close $server; |
63 | |
64 | # clean up |
65 | rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; |
66 | |
67 | is( $return, 0, 'live tests' ); |
68 | |
69 | sub check_port { |
70 | my ( $host, $port ) = @_; |
71 | |
72 | my $remote = IO::Socket::INET->new( |
73 | Proto => "tcp", |
74 | PeerAddr => $host, |
75 | PeerPort => $port |
76 | ); |
77 | if ($remote) { |
78 | close $remote; |
79 | return 1; |
80 | } |
81 | else { |
82 | return 0; |
83 | } |
84 | } |
85 | |
86 | sub prove { |
87 | if (!(my $pid = fork)) { |
88 | require App::Prove; |
89 | my $prove = App::Prove->new; |
90 | $prove->process_args(@_); |
91 | exit( $prove->run ? 0 : 1 ); |
92 | } else { |
93 | waitpid $pid, 0; |
94 | return $?; |
95 | } |
96 | } |