X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=14dcc4746a43508478b4a44585e71523bf06f388;hb=2d65525759b6ff95cd0838ccef48892d7d45b92b;hp=e940be060b70f45c3cc1e7336d06cea0ecf5eacf;hpb=8fa9321c8712ff964e93a72b4f78345d20400552;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm
index e940be0..14dcc47 100644
--- a/lib/Catalyst/Test.pm
+++ b/lib/Catalyst/Test.pm
@@ -44,7 +44,7 @@ my $build_exports = sub {
 
         ### place holder for $c after the request finishes; reset every time
         ### requests are done.
-        my $c;
+        my $ctx_closed_over;
 
         ### hook into 'dispatch' -- the function gets called after all plugins
         ### have done their work, and it's an easy place to capture $c.
@@ -52,7 +52,7 @@ my $build_exports = sub {
         my $meta = Class::MOP::get_metaclass_by_name($class);
         $meta->make_mutable;
         $meta->add_after_method_modifier( "dispatch", sub {
-            $c = shift;
+            $ctx_closed_over = shift;
         });
         $meta->make_immutable( replace_constructor => 1 );
         Class::C3::reinitialize(); # Fixes RT#46459, I've failed to write a test for how/why, but it does.
@@ -60,8 +60,18 @@ my $build_exports = sub {
         ### we've already stopped it from doing remote requests above.
         my $res = $request->( @_ );
 
+        # Make sure not to leave a reference $ctx hanging around.
+        # This means that the context will go out of scope as soon as the
+        # caller disposes of it, rather than waiting till the next time
+        # that ctx_request is called. This can be important if your $ctx
+        # ends up with a reference to a shared resource or lock (for example)
+        # which you want to clean up in test teardown - if the $ctx is still
+        # closed over then you're stuffed...
+        my $ctx = $ctx_closed_over;
+        undef $ctx_closed_over;
+
         ### return both values
-        return ( $res, $c );
+        return ( $res, $ctx );
     };
 
     return {
@@ -74,15 +84,15 @@ my $build_exports = sub {
         },
         action_ok => sub {
             my $action = shift;
-            return Test::More->builder->ok($request->($action)->is_success, @_);
+            return Test::More->builder->ok($request->($action)->is_success,@_ || "a route handler is defined for $action");
         },
         action_redirect => sub {
             my $action = shift;
-            return Test::More->builder->ok($request->($action)->is_redirect,@_);
+            return Test::More->builder->ok($request->($action)->is_redirect,@_ || "a route handler redirects for $action");
         },
         action_notfound => sub {
             my $action = shift;
-            return Test::More->builder->is_eq($request->($action)->code,404,@_);
+            return Test::More->builder->is_eq($request->($action)->code,404,@_ || "a route handler is not defined for $action");
         },
         contenttype_is => sub {
             my $action = shift;
@@ -239,6 +249,21 @@ sub local_request {
 
     my $response = $cgi->restore->response;
     $response->request( $request );
+
+    # HTML head parsing based on LWP::UserAgent
+
+    require HTML::HeadParser;
+
+    my $parser = HTML::HeadParser->new();
+    $parser->xml_mode(1) if $response->content_is_xhtml;
+    $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
+
+    $parser->parse( $response->content );
+    my $h = $parser->header;
+    for my $f ( $h->header_field_names ) {
+        $response->init_header( $f, [ $h->header($f) ] );
+    }
+
     return $response;
 }
 
@@ -319,25 +344,29 @@ sub _customize_request {
     }
 }
 
-=head2 action_ok
+=head2 action_ok($url [, $test_name ])
 
-Fetches the given URL and checks that the request was successful.
+Fetches the given URL and checks that the request was successful. An optional
+second argument can be given to specify the name of the test.
 
-=head2 action_redirect
+=head2 action_redirect($url [, $test_name ])
 
-Fetches the given URL and checks that the request was a redirect.
+Fetches the given URL and checks that the request was a redirect. An optional
+second argument can be given to specify the name of the test.
 
-=head2 action_notfound
+=head2 action_notfound($url [, $test_name ])
 
-Fetches the given URL and checks that the request was not found.
+Fetches the given URL and checks that the request was not found. An optional
+second argument can be given to specify the name of the test.
 
-=head2 content_like( $url, $regexp [, $test_name] )
+=head2 content_like( $url, $regexp [, $test_name ] )
 
-Fetches the given URL and returns whether the content matches the regexp.
+Fetches the given URL and returns whether the content matches the regexp. An
+optional third argument can be given to specify the name of the test.
 
-=head2 contenttype_is
+=head2 contenttype_is($url, $type [, $test_name ])
 
-Check for given MIME type.
+Verify the given URL has a content type of $type and optionally specify a test name.
 
 =head1 SEE ALSO