Commit | Line | Data |
c7ded7aa |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
26dd6d9f |
6 | use FindBin; |
7 | use lib "$FindBin::Bin/lib"; |
8 | use Test::More tests => 48; |
c7ded7aa |
9 | |
c7ded7aa |
10 | |
26dd6d9f |
11 | my $Class = 'Catalyst::Test'; |
12 | my $App = 'TestApp'; |
13 | my $Pkg = __PACKAGE__; |
14 | my $Url = 'http://localhost/'; |
15 | my $Content = "root index"; |
c7ded7aa |
16 | |
26dd6d9f |
17 | my %Meth = ( |
f2e13bbd |
18 | $Pkg => [qw|get request ctx_request|], # exported |
26dd6d9f |
19 | $Class => [qw|local_request remote_request|], # not exported |
20 | ); |
c7ded7aa |
21 | |
26dd6d9f |
22 | ### make sure we're not trying to connect to a remote host -- these are local tests |
23 | local $ENV{CATALYST_SERVER}; |
24 | |
25 | use_ok( $Class ); |
26 | |
27 | ### check available methods |
28 | { ### turn of redefine warnings, we'll get new subs exported |
29 | ### XXX 'no warnings' and 'local $^W' wont work as warnings are turned on in |
30 | ### test.pm, so trap them for now --kane |
31 | { local $SIG{__WARN__} = sub {}; |
32 | ok( $Class->import, "Argumentless import for methods only" ); |
33 | } |
34 | |
35 | while( my($class, $meths) = each %Meth ) { |
36 | for my $meth ( @$meths ) { SKIP: { |
37 | |
38 | ### method available? |
39 | can_ok( $class, $meth ); |
40 | |
41 | ### only for exported methods |
42 | skip "Error tests only for exported methods", 2 unless $class eq $Pkg; |
43 | |
44 | ### check error conditions |
45 | eval { $class->can($meth)->( $Url ) }; |
46 | ok( $@, " $meth without app gives error" ); |
47 | like( $@, qr/$Class/, |
48 | " Error filled with expected content for '$meth'" ); |
49 | } } |
50 | } |
51 | } |
52 | |
53 | ### simple tests for exported methods |
54 | { ### turn of redefine warnings, we'll get new subs exported |
55 | ### XXX 'no warnings' and 'local $^W' wont work as warnings are turned on in |
56 | ### test.pm, so trap them for now --kane |
57 | { local $SIG{__WARN__} = sub {}; |
58 | ok( $Class->import( $App ), |
59 | "Loading $Class for App $App" ); |
60 | } |
61 | |
62 | ### test exported methods again |
63 | for my $meth ( @{ $Meth{$Pkg} } ) { SKIP: { |
64 | |
f2e13bbd |
65 | ### do a call, we should get a result and perhaps a $c if it's 'ctx_request'; |
26dd6d9f |
66 | my ($res, $c) = eval { $Pkg->can($meth)->( $Url ) }; |
67 | |
68 | ok( 1, " Called $Pkg->$meth( $Url )" ); |
69 | ok( !$@, " No critical error $@" ); |
70 | ok( $res, " Result obtained" ); |
71 | |
72 | ### get the content as a string, to make sure we got what we expected |
73 | my $res_as_string = $meth eq 'get' ? $res : $res->content; |
74 | is( $res_as_string, $Content, |
75 | " Content as expected: $res_as_string" ); |
76 | |
f2e13bbd |
77 | ### some tests for 'ctx_request' |
78 | skip "Context tests skipped for '$meth'", 6 unless $meth eq 'ctx_request'; |
26dd6d9f |
79 | |
80 | ok( $c, " Context object returned" ); |
81 | isa_ok( $c, $App, " Object" ); |
82 | is( $c->request->uri, $Url, |
83 | " Url recorded in request" ); |
84 | is( $c->response->body, $Content, |
85 | " Content recorded in response" ); |
86 | ok( $c->stash, " Stash accessible" ); |
87 | ok( $c->action, " Action object accessible" ); |
88 | } } |
89 | } |