Fix body predicate bug/back compat issue

diff --git a/Changes b/Changes
index cb244df..7ed6fb8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+Bug fixes:
+  - Fix compatibility issue with code which was testing the value of
+    $c->res->body multiple times. Previously this would cause the value
+    to be built, and ergo cause the $c->res->has_body predicate to start
+    returning true.
+    Having a response body is indicated by $c->res->body being defined.
+
 5.80031 2011-01-31 08:13:02
 
  Bug fixes:

diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm
index 9c8a4b2..2bf4dfe 100644 (file)
--- a/lib/Catalyst/Response.pm
+++ b/lib/Catalyst/Response.pm
@@ -6,7 +6,8 @@ use HTTP::Headers;
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
 has cookies   => (is => 'rw', default => sub { {} });
-has body      => (is => 'rw', default => undef, lazy => 1, predicate => 'has_body');
+has body      => (is => 'rw', default => undef);
+sub has_body { defined($_[0]->body) }
 
 has location  => (is => 'rw');
 has status    => (is => 'rw', default => 200);

diff --git a/t/aggregate/live_engine_response_body.t b/t/aggregate/live_engine_response_body.t
new file mode 100644 (file)
index 0000000..cd0236b
--- /dev/null
+++ b/t/aggregate/live_engine_response_body.t
@@ -0,0 +1,14 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Catalyst::Test 'TestApp';
+
+ok( request('/body_semipredicate')->is_success );
+
+done_testing;

diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm
index e34eacd..ce3ee75 100644 (file)
--- a/t/lib/TestApp/Controller/Root.pm
+++ b/t/lib/TestApp/Controller/Root.pm
@@ -75,6 +75,13 @@ EndOfBody
     $c->response->body($body);
 }
 
+sub body_semipredicate : Local {
+    my ($self, $c) = @_;
+    $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
+    $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
+    $c->res->body('Body');
+}
+
 sub end : Private {
     my ($self,$c) = @_;
 }