[Catalyst-commits] r9407 - in Test-WWW-Mechanize-Catalyst/trunk: . lib/Test/WWW/Mechanize t t/lib

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2009-03-01 17:15:46 +0000 (Sun, 01 Mar 2009)
New Revision: 9407

Modified:
   Test-WWW-Mechanize-Catalyst/trunk/CHANGES
   Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm
   Test-WWW-Mechanize-Catalyst/trunk/svn.authors
   Test-WWW-Mechanize-Catalyst/trunk/t/lib/Catty.pm
   Test-WWW-Mechanize-Catalyst/trunk/t/redirect.t
Log:
TWMC: Fix bug where redirect was followed on a 500 response

Modified: Test-WWW-Mechanize-Catalyst/trunk/CHANGES
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/CHANGES	2009-03-01 11:44:22 UTC (rev 9406)
+++ Test-WWW-Mechanize-Catalyst/trunk/CHANGES	2009-03-01 17:15:46 UTC (rev 9407)
@@ -2,6 +2,7 @@
 
      - Doc updates from Jester
      - User agent fixes from ANDREMAR
+     - Fix bug where redirect was followed on a 500 response
 
 0.50 Tue Feb 17 09:12 GMT 2009
      - Remove warning in HTTP::Cookies

Modified: Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm	2009-03-01 11:44:22 UTC (rev 9406)
+++ Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm	2009-03-01 17:15:46 UTC (rev 9407)
@@ -99,6 +99,7 @@
 
     # check if that was a redirect
     if (   $response->header('Location')
+        && $response->is_redirect
         && $self->redirect_ok( $request, $response ) )
     {
 

Modified: Test-WWW-Mechanize-Catalyst/trunk/svn.authors
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/svn.authors	2009-03-01 11:44:22 UTC (rev 9406)
+++ Test-WWW-Mechanize-Catalyst/trunk/svn.authors	2009-03-01 17:15:46 UTC (rev 9407)
@@ -1 +1 @@
-ashb = Ash Berlin <ash_github at firemirror.com>
+ash = Ash Berlin <ash_github at firemirror.com>

Modified: Test-WWW-Mechanize-Catalyst/trunk/t/lib/Catty.pm
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/t/lib/Catty.pm	2009-03-01 11:44:22 UTC (rev 9406)
+++ Test-WWW-Mechanize-Catalyst/trunk/t/lib/Catty.pm	2009-03-01 17:15:46 UTC (rev 9407)
@@ -1,6 +1,7 @@
 package Catty;
 
 use strict;
+use warnings;
 
 #use Catalyst;
 use Catalyst;
@@ -76,6 +77,13 @@
     }
 }
 
+sub redirect_with_500 : Global {
+    my ( $self, $c ) = @_;
+    $DB::single = 1;
+    $c->res->redirect( $c->uri_for("/bonjour"));
+    die "erk!";
+}
+
 sub die : Global {
     my ( $self, $context ) = @_;
     my $html = html( "Die", "This is the die page" );

Modified: Test-WWW-Mechanize-Catalyst/trunk/t/redirect.t
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/t/redirect.t	2009-03-01 11:44:22 UTC (rev 9406)
+++ Test-WWW-Mechanize-Catalyst/trunk/t/redirect.t	2009-03-01 17:15:46 UTC (rev 9407)
@@ -1,8 +1,8 @@
-#!perl -T
+#!perl
 use strict;
 use warnings;
 use lib 'lib';
-use Test::More tests => 27;
+use Test::More tests => 28;
 use lib 't/lib';
 use Test::WWW::Mechanize::Catalyst 'Catty';
 
@@ -30,3 +30,6 @@
 ok( $prev, "have a previous previous" );
 is( $prev->code, 302, "was a redirect" );
 like( $prev->header('Location'), '/hi$/', "to the right place" );
+
+$m->get("$root/redirect_with_500");
+is ($m->status, 500, "Redirect not followed on 500");