X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Funit_load_catalyst_test.t;h=07cc38c25eacd7401f35c845fc404fda6de41726;hb=aa2e6d9e59b1373b13fe7c37725f3fab3b8a1e92;hp=aadcbe27e024780fddf12a68541572bf68868ac9;hpb=26dd6d9f6575fe782e78d6845fff3447e5ba5744;p=catagits%2FCatalyst-Runtime.git diff --git a/t/unit_load_catalyst_test.t b/t/unit_load_catalyst_test.t index aadcbe2..07cc38c 100644 --- a/t/unit_load_catalyst_test.t +++ b/t/unit_load_catalyst_test.t @@ -5,8 +5,12 @@ use warnings; use FindBin; use lib "$FindBin::Bin/lib"; -use Test::More tests => 48; - +use Test::More tests => 59; +use FindBin qw/$Bin/; +use lib "$Bin/lib"; +use Catalyst::Utils; +use HTTP::Request::Common; +use Test::Exception; my $Class = 'Catalyst::Test'; my $App = 'TestApp'; @@ -15,7 +19,7 @@ my $Url = 'http://localhost/'; my $Content = "root index"; my %Meth = ( - $Pkg => [qw|get request crequest|], # exported + $Pkg => [qw|get request ctx_request|], # exported $Class => [qw|local_request remote_request|], # not exported ); @@ -62,7 +66,7 @@ use_ok( $Class ); ### test exported methods again for my $meth ( @{ $Meth{$Pkg} } ) { SKIP: { - ### do a call, we should get a result and perhaps a $c if it's 'crequest'; + ### do a call, we should get a result and perhaps a $c if it's 'ctx_request'; my ($res, $c) = eval { $Pkg->can($meth)->( $Url ) }; ok( 1, " Called $Pkg->$meth( $Url )" ); @@ -74,8 +78,8 @@ use_ok( $Class ); is( $res_as_string, $Content, " Content as expected: $res_as_string" ); - ### some tests for 'crequest' - skip "Context tests skipped for '$meth'", 6 unless $meth eq 'crequest'; + ### some tests for 'ctx_request' + skip "Context tests skipped for '$meth'", 6 unless $meth eq 'ctx_request'; ok( $c, " Context object returned" ); isa_ok( $c, $App, " Object" ); @@ -87,3 +91,64 @@ use_ok( $Class ); ok( $c->action, " Action object accessible" ); } } } + +### perl5.8.8 + cat 5.80's Cat::Test->ctx_request didn't return $c the 2nd +### time it was invoked. Without tracking the bug down all the way, it was +### clearly related to the Moose'ification of Cat::Test and a scoping issue +### with a 'my'd variable. Since the same code works fine in 5.10, a bug in +### either Moose or perl 5.8 is suspected. +{ ok( 1, "Testing consistency of ctx_request()" ); + for( 1..2 ) { + my($res, $c) = ctx_request( $Url ); + ok( $c, " Call $_: Context object returned" ); + } +} + +# FIXME - These vhosts in tests tests should be somewhere else... + +sub customize { Catalyst::Test::_customize_request(@_) } + +{ + my $req = Catalyst::Utils::request('/dummy'); + customize( $req ); + is( $req->header('Host'), undef, 'normal request is unmodified' ); +} + +{ + my $req = Catalyst::Utils::request('/dummy'); + customize( $req, { host => 'customized.com' } ); + like( $req->header('Host'), qr/customized.com/, 'request is customizable via opts hash' ); +} + +{ + my $req = Catalyst::Utils::request('/dummy'); + local $Catalyst::Test::default_host = 'localized.com'; + customize( $req ); + like( $req->header('Host'), qr/localized.com/, 'request is customizable via package var' ); +} + +{ + my $req = Catalyst::Utils::request('/dummy'); + local $Catalyst::Test::default_host = 'localized.com'; + customize( $req, { host => 'customized.com' } ); + like( $req->header('Host'), qr/customized.com/, 'opts hash takes precedence over package var' ); +} + +{ + my $req = Catalyst::Utils::request('/dummy'); + local $Catalyst::Test::default_host = 'localized.com'; + customize( $req, { host => '' } ); + is( $req->header('Host'), undef, 'default value can be temporarily cleared via opts hash' ); +} + +# Back compat test, extra args used to be ignored, now a hashref of options. +use_ok('Catalyst::Test', 'TestApp', 'foobar'); + +# Back compat test, ensure that request ignores anything which isn't a hash. +lives_ok { + request(GET('/dummy'), 'foo'); +} 'scalar additional param to request method ignored'; +lives_ok { + request(GET('/dummy'), []); +} 'array additional param to request method ignored'; +