Commit | Line | Data |
040850b3 |
1 | use strict; |
2 | use warnings; |
3 | |
81f25ce6 |
4 | use Test::More tests => 1; |
5ac4489b |
5 | use Test::TCP; |
4853fb50 |
6 | |
040850b3 |
7 | use File::Path; |
8 | use FindBin; |
a526c982 |
9 | use Net::EmptyPort qw(wait_port empty_port); |
29057674 |
10 | use Try::Tiny; |
876db346 |
11 | use Plack::Builder; |
f0ee1a76 |
12 | |
86b73ee0 |
13 | eval { require Catalyst::Devel; Catalyst::Devel->VERSION(1.0); 1; } || do { |
14 | fail("Could not load Catalyst::Devel: $@"); |
15 | exit 1; |
16 | }; |
17 | |
18 | eval { require File::Copy::Recursive; 1 } || do { |
19 | fail("Could not load File::Copy::Recursive: $@"); |
20 | exit 1; |
21 | }; |
040850b3 |
22 | |
547f8806 |
23 | # Run a single test by providing it as the first arg |
24 | my $single_test = shift; |
25 | |
81f25ce6 |
26 | my $tmpdir = "$FindBin::Bin/../../t/tmp"; |
2f381252 |
27 | |
040850b3 |
28 | # clean up |
2f381252 |
29 | rmtree $tmpdir if -d $tmpdir; |
040850b3 |
30 | |
31 | # create a TestApp and copy the test libs into it |
2f381252 |
32 | mkdir $tmpdir; |
33 | chdir $tmpdir; |
81f25ce6 |
34 | system( $^X, "-I$FindBin::Bin/../../lib", "$FindBin::Bin/../../script/catalyst.pl", 'TestApp' ); |
67c3b305 |
35 | chdir "$FindBin::Bin/.."; |
81f25ce6 |
36 | File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die; |
10bdcbe8 |
37 | |
38 | # remove TestApp's tests |
81f25ce6 |
39 | rmtree '../t/tmp/TestApp/t' or die; |
040850b3 |
40 | |
41 | # spawn the standalone HTTP server |
29057674 |
42 | my $port = empty_port; |
d93d402c |
43 | |
44 | my $pid = fork; |
45 | if ($pid) { |
46 | # parent. |
47 | print "Waiting for server to start...\n"; |
29057674 |
48 | wait_port_timeout($port, 30); |
d93d402c |
49 | } elsif ($pid == 0) { |
50 | # child process |
51 | unshift @INC, "$tmpdir/TestApp/lib", "$FindBin::Bin/../../lib"; |
52 | require TestApp; |
53 | |
1316cc64 |
54 | my $psgi_app = TestApp->apply_default_middlewares(TestApp->psgi_app); |
876db346 |
55 | Plack::Loader->auto(port => $port)->run(builder { |
56 | mount '/test_prefix' => $psgi_app; |
57 | mount '/' => sub { |
58 | return [501, ['Content-Type' => 'text/plain'], ['broken tests']]; |
59 | }; |
60 | }); |
d93d402c |
61 | |
62 | exit 0; |
63 | } else { |
64 | die "fork failed: $!"; |
896c9ed2 |
65 | } |
32e231eb |
66 | |
040850b3 |
67 | # run the testsuite against the HTTP server |
876db346 |
68 | $ENV{CATALYST_SERVER} = "http://localhost:$port/test_prefix"; |
547f8806 |
69 | |
e8e8895a |
70 | chdir '..'; |
71 | |
2f381252 |
72 | my $return; |
547f8806 |
73 | if ( $single_test ) { |
e8e8895a |
74 | $return = system( "$^X -Ilib/ $single_test" ); |
547f8806 |
75 | } |
76 | else { |
529d5abc |
77 | $return = prove(grep { $_ ne '..' } glob('t/aggregate/live_*.t')); |
547f8806 |
78 | } |
040850b3 |
79 | |
80 | # shut it down |
e1b364f4 |
81 | kill 'INT', $pid; |
040850b3 |
82 | |
83 | # clean up |
81f25ce6 |
84 | rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; |
896c9ed2 |
85 | |
2f381252 |
86 | is( $return, 0, 'live tests' ); |
55ddccae |
87 | |
4d7d4257 |
88 | # kill 'INT' doesn't exist in Windows, so to prevent child hanging, |
89 | # this process will need to commit seppuku to clean up the children. |
90 | if ($^O eq 'MSWin32') { |
807303a1 |
91 | # Furthermore, it needs to do it 'politely' so that TAP doesn't |
4d7d4257 |
92 | # smell anything 'dubious'. |
93 | require Win32::Process; # core in all versions of Win32 Perl |
94 | Win32::Process::KillProcess($$, $return); |
95 | } |
96 | |
29057674 |
97 | sub wait_port_timeout { |
98 | my ($port, $timeout) = @_; |
99 | |
5ac4489b |
100 | wait_port($port, $timeout * 10) and return; |
29057674 |
101 | |
102 | die "Server did not start within $timeout seconds"; |
896c9ed2 |
103 | } |
868a7cca |
104 | |
105 | sub prove { |
529d5abc |
106 | my (@tests) = @_; |
868a7cca |
107 | if (!(my $pid = fork)) { |
641b0131 |
108 | require TAP::Harness; |
e8e8895a |
109 | |
e8e8895a |
110 | my $harness = TAP::Harness->new({ |
529d5abc |
111 | lib => ['lib'], |
e8e8895a |
112 | }); |
113 | |
a1e953c8 |
114 | my $aggregator = $harness->runtests(@tests); |
641b0131 |
115 | |
116 | exit $aggregator->has_errors ? 1 : 0; |
868a7cca |
117 | } else { |
118 | waitpid $pid, 0; |
119 | return $?; |
120 | } |
121 | } |