[Catalyst-commits] r6619 - trunk/Catalyst-Engine-HTTP-POE/t

andyg at dev.catalyst.perl.org andyg at dev.catalyst.perl.org
Fri Aug 3 18:07:12 GMT 2007


Author: andyg
Date: 2007-08-03 18:07:11 +0100 (Fri, 03 Aug 2007)
New Revision: 6619

Added:
   trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_body_demand.t
Modified:
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_auto.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_begin.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_detach.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_index.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_regexp.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_streaming.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_args.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_parameters.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_uri.t
   trunk/Catalyst-Engine-HTTP-POE/t/live_engine_response_large.t
Log:
Sync up tests in POE engine

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_auto.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_auto.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_auto.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -35,7 +35,7 @@
           TestApp::Controller::Action::Auto->begin
           TestApp::Controller::Action::Auto->auto
           TestApp::Controller::Action::Auto->one
-	  TestApp->end
+          TestApp->end
         ];
     
         my $expected = join( ", ", @expected );
@@ -52,7 +52,7 @@
           TestApp::Controller::Action::Auto->begin
           TestApp::Controller::Action::Auto->auto
           TestApp::Controller::Action::Auto->default
-	  TestApp->end
+          TestApp->end
         ];
     
         my $expected = join( ", ", @expected );
@@ -70,7 +70,7 @@
           TestApp::Controller::Action::Auto->auto
           TestApp::Controller::Action::Auto::Deep->auto
           TestApp::Controller::Action::Auto::Deep->one
-	  TestApp->end
+          TestApp->end
         ];
     
         my $expected = join( ", ", @expected );
@@ -88,7 +88,7 @@
           TestApp::Controller::Action::Auto->auto
           TestApp::Controller::Action::Auto::Deep->auto
           TestApp::Controller::Action::Auto::Deep->default
-	  TestApp->end
+          TestApp->end
         ];
     
         my $expected = join( ", ", @expected );

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_begin.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_begin.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_begin.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -30,7 +30,7 @@
           TestApp::Controller::Action::Begin->begin
           TestApp::Controller::Action::Begin->default
           TestApp::View::Dump::Request->process
-	  TestApp->end
+          TestApp->end
         ];
 
         my $expected = join( ", ", @expected );

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_detach.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_detach.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_detach.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -1,100 +1,100 @@
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-
-our $iters;
-
-BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-
-use Test::More tests => 18*$iters;
-use Catalyst::Test 'TestApp';
-
-if ( $ENV{CAT_BENCHMARK} ) {
-    require Benchmark;
-    Benchmark::timethis( $iters, \&run_tests );
-}
-else {
-    for ( 1 .. $iters ) {
-        run_tests();
-    }
-}
-
-sub run_tests {
-    {
-        my @expected = qw[
-          TestApp::Controller::Action::Detach->begin
-          TestApp::Controller::Action::Detach->one
-          TestApp::Controller::Action::Detach->two
-          TestApp::View::Dump::Request->process
-	  TestApp->end
-        ];
-
-        my $expected = join( ", ", @expected );
-
-        # Test detach to chain of actions.
-        ok( my $response = request('http://localhost/action/detach/one'),
-            'Request' );
-        ok( $response->is_success, 'Response Successful 2xx' );
-        is( $response->content_type, 'text/plain', 'Response Content-Type' );
-        is( $response->header('X-Catalyst-Action'),
-            'action/detach/one', 'Test Action' );
-        is(
-            $response->header('X-Test-Class'),
-            'TestApp::Controller::Action::Detach',
-            'Test Class'
-        );
-        is( $response->header('X-Catalyst-Executed'),
-            $expected, 'Executed actions' );
-    }
-
-    {
-        my @expected = qw[
-          TestApp::Controller::Action::Detach->begin
-          TestApp::Controller::Action::Detach->path
-          TestApp::Controller::Action::Detach->two
-          TestApp::View::Dump::Request->process
-	  TestApp->end
-        ];
-
-        my $expected = join( ", ", @expected );
-
-        # Test detach to chain of actions.
-        ok( my $response = request('http://localhost/action/detach/path'),
-            'Request' );
-        ok( $response->is_success, 'Response Successful 2xx' );
-        is( $response->content_type, 'text/plain', 'Response Content-Type' );
-        is( $response->header('X-Catalyst-Action'),
-            'action/detach/path', 'Test Action' );
-        is(
-            $response->header('X-Test-Class'),
-            'TestApp::Controller::Action::Detach',
-            'Test Class'
-        );
-        is( $response->header('X-Catalyst-Executed'),
-            $expected, 'Executed actions' );
-    }
-
-    {
-        ok(
-            my $response =
-              request('http://localhost/action/detach/with_args/old'),
-            'Request with args'
-        );
-        ok( $response->is_success, 'Response Successful 2xx' );
-        is( $response->content, 'new' );
-    }
-
-    {
-        ok(
-            my $response = request(
-                'http://localhost/action/detach/with_method_and_args/old'),
-            'Request with args and method'
-        );
-        ok( $response->is_success, 'Response Successful 2xx' );
-        is( $response->content, 'new' );
-    }
-}
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 18*$iters;
+use Catalyst::Test 'TestApp';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+    require Benchmark;
+    Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+    for ( 1 .. $iters ) {
+        run_tests();
+    }
+}
+
+sub run_tests {
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Detach->begin
+          TestApp::Controller::Action::Detach->one
+          TestApp::Controller::Action::Detach->two
+          TestApp::View::Dump::Request->process
+          TestApp->end
+        ];
+
+        my $expected = join( ", ", @expected );
+
+        # Test detach to chain of actions.
+        ok( my $response = request('http://localhost/action/detach/one'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/detach/one', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Detach',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+    }
+
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Detach->begin
+          TestApp::Controller::Action::Detach->path
+          TestApp::Controller::Action::Detach->two
+          TestApp::View::Dump::Request->process
+          TestApp->end
+        ];
+
+        my $expected = join( ", ", @expected );
+
+        # Test detach to chain of actions.
+        ok( my $response = request('http://localhost/action/detach/path'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/detach/path', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Detach',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+    }
+
+    {
+        ok(
+            my $response =
+              request('http://localhost/action/detach/with_args/old'),
+            'Request with args'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'new' );
+    }
+
+    {
+        ok(
+            my $response = request(
+                'http://localhost/action/detach/with_method_and_args/old'),
+            'Request with args and method'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'new' );
+    }
+}

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_index.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_index.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_index.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -87,7 +87,7 @@
         my @expected = qw[
           TestApp::Controller::Action::Index->begin
           TestApp::Controller::Action::Index->default
-	  TestApp->end
+          TestApp->end
         ];
     
         my $expected = join( ", ", @expected );

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_regexp.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_regexp.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_regexp.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -10,9 +10,11 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 12*$iters;
+use Test::More tests => 28*$iters;
 use Catalyst::Test 'TestApp';
 
+use Catalyst::Request;
+
 if ( $ENV{CAT_BENCHMARK} ) {
     require Benchmark;
     Benchmark::timethis( $iters, \&run_tests );
@@ -61,4 +63,44 @@
             'Content is a serialized Catalyst::Request'
         );
     }
+
+    {
+        ok( my $response = request('http://localhost/action/regexp/mandatory'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Regexp',
+            'Test Class'
+        );
+        my $content = $response->content;
+        my $req = eval $content; 
+
+        is( scalar @{ $req->captures }, 2, 'number of captures' );
+        is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
+        ok( !defined $req->captures->[ 1 ], 'optional capture' );
+    }
+
+    {
+        ok( my $response = request('http://localhost/action/regexp/mandatory/optional'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Regexp',
+            'Test Class'
+        );
+        my $content = $response->content;
+        my $req = eval $content; 
+
+        is( scalar @{ $req->captures }, 2, 'number of captures' );
+        is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
+        is( $req->captures->[ 1 ], '/optional', 'optional capture' );
+    }
 }

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_streaming.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_streaming.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_action_streaming.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -10,7 +10,7 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 8*$iters;
+use Test::More tests => 10*$iters;
 use Catalyst::Test 'TestApp';
 
 if ( $ENV{CAT_BENCHMARK} ) {
@@ -29,6 +29,17 @@
         ok( my $response = request('http://localhost/streaming'), 'Request' );
         ok( $response->is_success, 'Response Successful 2xx' );
         is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        
+        SKIP:
+        {
+            if ( $ENV{CATALYST_SERVER} ) {
+                skip "Using remote server", 1;
+            }
+            
+            # XXX: Length should be undef here, but HTTP::Request::AsCGI sets it
+            is( $response->content_length, 12, 'Response Content-Length' );
+        }
+        
         is( $response->content,, <<'EOF', 'Content is a stream' );
 foo
 bar
@@ -40,7 +51,7 @@
   SKIP:
     {
         if ( $ENV{CATALYST_SERVER} ) {
-            skip "Using remote server", 4;
+            skip "Using remote server", 5;
         }
 
         my $file = "$FindBin::Bin/01use.t";
@@ -55,6 +66,7 @@
             'Request' );
         ok( $response->is_success, 'Response Successful 2xx' );
         is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->content_length, -s $file, 'Response Content-Length' );
         is( $response->content, $buffer, 'Content is read from filehandle' );
     }
 }

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_args.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_args.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_component_controller_args.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -13,21 +13,21 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1;
 
-	# add special paths to test here
-	@paths = (
-	            # all reserved in uri's
-		    qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#',
+    # add special paths to test here
+    @paths = (
+        # all reserved in uri's
+        qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#',
 
-		    # unreserved
-		    'a'..'z','A'..'Z',0..9,qw( - . _ ~ ),
-		    " ",
+        # unreserved
+        'a'..'z','A'..'Z',0..9,qw( - . _ ~ ),
+        " ",
 
-		    # just to test %2F/%
-		    [ qw~ / / ~ ],
+        # just to test %2F/%
+        [ qw~ / / ~ ],
 
-		    # testing %25/%25
-		    [ qw~ % % ~ ],
-		 );
+        # testing %25/%25
+        [ qw~ % % ~ ],
+    );
 }
 
 use Test::More tests => 6*@paths * $iters;

Copied: trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_body_demand.t (from rev 6618, trunk/Catalyst-Runtime/t/live_engine_request_body_demand.t)
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_body_demand.t	                        (rev 0)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_body_demand.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -0,0 +1,66 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 8;
+use Catalyst::Test 'TestAppOnDemand';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+# Test a simple POST request to make sure body parsing
+# works in on-demand mode.
+SKIP:
+{
+    if ( $ENV{CATALYST_SERVER} ) {
+        skip "Using remote server", 8;
+    }
+    
+    {
+        my $params;
+
+        my $request = POST(
+            'http://localhost/body/params',
+            'Content-Type' => 'application/x-www-form-urlencoded',
+            'Content'      => 'foo=bar&baz=quux'
+        );
+    
+        my $expected = { foo => 'bar', baz => 'quux' };
+
+        ok( my $response = request($request), 'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+
+        {
+            no strict 'refs';
+            ok(
+                eval '$params = ' . $response->content,
+                'Unserialize params'
+            );
+        }
+
+        is_deeply( $params, $expected, 'Catalyst::Request body parameters' );
+    }
+
+    # Test reading chunks of the request body using $c->read
+    {
+        my $creq;
+    
+        my $request = POST(
+            'http://localhost/body/read',
+            'Content-Type' => 'text/plain',
+            'Content'      => 'x' x 105_000
+        );
+    
+        my $expected = '10000|10000|10000|10000|10000|10000|10000|10000|10000|10000|5000';
+
+        ok( my $response = request($request), 'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->content, $expected, 'Response Content' );
+    }
+}

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_parameters.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_parameters.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_parameters.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -111,7 +111,7 @@
     ok( my $response = request($request), 'Request' );
     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
     is( $creq->{uri}->query, 'query+string', 'Catalyst::Request POST query_string' );
-    is( $creq->keywords, 'query string', 'Catalyst::Request keywords' );
+    is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' );
     is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
     
     ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_uri.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_uri.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_engine_request_uri.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -1,106 +1,106 @@
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-
-use Test::More tests => 44;
-use Catalyst::Test 'TestApp';
-use Catalyst::Request;
-
-my $creq;
-
-# test that the path can be changed
-{
-    ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
-    like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
-}
-
-# test that path properly removes the base location
-{
-    ok( my $response = request('http://localhost/engine/request/uri/change_base'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
-    like( $creq->base, qr{/new/location}, 'Base URI contains new location' );
-    is( $creq->path, 'engine/request/uri/change_base', 'URI contains correct path' );
-}
-
-# test that base + path is correct
-{
-    ok( my $response = request('http://localhost/engine/request/uri'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
-    is( $creq->base . $creq->path, $creq->uri, 'Base + Path ok' );
-}
-
-# test that we can use semi-colons as separators
-{
-    my $parameters = {
-        a => [ qw/1 2/ ],
-        b => 3,
-    };
-    
-    ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
-    is( $creq->{uri}->query, 'a=1;a=2;b=3', 'Query string ok' );
-    is_deeply( $creq->{parameters}, $parameters, 'Parameters ok' );
-}
-
-# test that query params are unescaped properly
-{
-    ok( my $response = request('http://localhost/engine/request/uri?text=Catalyst%20Rocks'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
-    is( $creq->{uri}->query, 'text=Catalyst%20Rocks', 'Query string ok' );
-    is( $creq->{parameters}->{text}, 'Catalyst Rocks', 'Unescaped param ok' );
-}
-
-# test that uri_with adds params
-{
-    ok( my $response = request('http://localhost/engine/request/uri/uri_with'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    ok( !defined $response->header( 'X-Catalyst-Param-a' ), 'param "a" ok' );
-    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
-}
-
-# test that uri_with adds params (and preserves)
-{
-    ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
-    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
-}
-
-# test that uri_with replaces params (and preserves)
-{
-    ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1&b=2'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
-    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
-}
-
-# test that uri_with replaces params (and preserves)
-{
-    ok( my $response = request('http://localhost/engine/request/uri/uri_with_object'), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    like( $response->header( 'X-Catalyst-Param-a' ), qr(http://localhost[^/]*/), 'param "a" ok' );
-}
-
-# test that uri_with is utf8 safe
-{
-    ok( my $response = request("http://localhost/engine/request/uri/uri_with_utf8"), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    like( $response->header( 'X-Catalyst-uri-with' ), qr/%E2%98%A0$/, 'uri_with ok' );
-}
+#!perl
 
-# test with undef -- no warnings should be thrown
-{
-    ok( my $response = request("http://localhost/engine/request/uri/uri_with_undef"), 'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    is( $response->header( 'X-Catalyst-warnings' ), 0, 'no warnings emitted' );
-}
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 44;
+use Catalyst::Test 'TestApp';
+use Catalyst::Request;
+
+my $creq;
+
+# test that the path can be changed
+{
+    ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
+}
+
+# test that path properly removes the base location
+{
+    ok( my $response = request('http://localhost/engine/request/uri/change_base'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    like( $creq->base, qr{/new/location}, 'Base URI contains new location' );
+    is( $creq->path, 'engine/request/uri/change_base', 'URI contains correct path' );
+}
+
+# test that base + path is correct
+{
+    ok( my $response = request('http://localhost/engine/request/uri'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    is( $creq->base . $creq->path, $creq->uri, 'Base + Path ok' );
+}
+
+# test that we can use semi-colons as separators
+{
+    my $parameters = {
+        a => [ qw/1 2/ ],
+        b => 3,
+    };
+    
+    ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    is( $creq->{uri}->query, 'a=1;a=2;b=3', 'Query string ok' );
+    is_deeply( $creq->{parameters}, $parameters, 'Parameters ok' );
+}
+
+# test that query params are unescaped properly
+{
+    ok( my $response = request('http://localhost/engine/request/uri?text=Catalyst%20Rocks'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    is( $creq->{uri}->query, 'text=Catalyst%20Rocks', 'Query string ok' );
+    is( $creq->{parameters}->{text}, 'Catalyst Rocks', 'Unescaped param ok' );
+}
+
+# test that uri_with adds params
+{
+    ok( my $response = request('http://localhost/engine/request/uri/uri_with'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    ok( !defined $response->header( 'X-Catalyst-Param-a' ), 'param "a" ok' );
+    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with adds params (and preserves)
+{
+    ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
+    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with replaces params (and preserves)
+{
+    ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1&b=2'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
+    is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with replaces params (and preserves)
+{
+    ok( my $response = request('http://localhost/engine/request/uri/uri_with_object'), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    like( $response->header( 'X-Catalyst-Param-a' ), qr(http://localhost[^/]*/), 'param "a" ok' );
+}
+
+# test that uri_with is utf8 safe
+{
+    ok( my $response = request("http://localhost/engine/request/uri/uri_with_utf8"), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    like( $response->header( 'X-Catalyst-uri-with' ), qr/%E2%98%A0$/, 'uri_with ok' );
+}
+
+# test with undef -- no warnings should be thrown
+{
+    ok( my $response = request("http://localhost/engine/request/uri/uri_with_undef"), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    is( $response->header( 'X-Catalyst-warnings' ), 0, 'no warnings emitted' );
+}

Modified: trunk/Catalyst-Engine-HTTP-POE/t/live_engine_response_large.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-POE/t/live_engine_response_large.t	2007-08-03 16:58:15 UTC (rev 6618)
+++ trunk/Catalyst-Engine-HTTP-POE/t/live_engine_response_large.t	2007-08-03 17:07:11 UTC (rev 6619)
@@ -1,27 +1,27 @@
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-
-use Test::More tests => 6;
-use Catalyst::Test 'TestApp';
-
-# phaylon noticed that refactored was truncating output on large images.
-# This test tests 100K and 1M output content.
-
-my $expected = {
-    one => 'x' x (100 * 1024),
-    two => 'y' x (1024 * 1024),
-};
-
-for my $action ( keys %{$expected} ) {
-    ok( my $response = request('http://localhost/engine/response/large/' . $action ),
-        'Request' );
-    ok( $response->is_success, 'Response Successful 2xx' );
-    
-    is( length( $response->content ), length( $expected->{$action} ), 'Length OK' );
-}
-
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 6;
+use Catalyst::Test 'TestApp';
+
+# phaylon noticed that refactored was truncating output on large images.
+# This test tests 100K and 1M output content.
+
+my $expected = {
+    one => 'x' x (100 * 1024),
+    two => 'y' x (1024 * 1024),
+};
+
+for my $action ( keys %{$expected} ) {
+    ok( my $response = request('http://localhost/engine/response/large/' . $action ),
+        'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    
+    is( length( $response->content ), length( $expected->{$action} ), 'Length OK' );
+}
+




More information about the Catalyst-commits mailing list