Passing test case for RT #53678 - Catalyst::Test::get currently doesn't decode the...

diff --git a/t/aggregate/catalyst_test_utf8.t b/t/aggregate/catalyst_test_utf8.t
new file mode 100644 (file)
index 0000000..d8eb56f
--- /dev/null
+++ b/t/aggregate/catalyst_test_utf8.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+# "binmode STDOUT, ':utf8'" is insufficient, see http://code.google.com/p/test-more/issues/detail?id=46#c1
+binmode Test::More->builder->output, ":utf8";
+binmode Test::More->builder->failure_output, ":utf8";
+
+use Catalyst::Test 'TestAppEncoding';
+
+plan skip_all => 'This test does not run live'
+    if $ENV{CATALYST_SERVER};
+
+{   
+    # Test for https://rt.cpan.org/Ticket/Display.html?id=53678
+    # Catalyst::Test::get currently returns the raw octets, but it
+    # would be more useful if it decoded the content based on the
+    # Content-Type charset, as Test::WWW::Mechanize::Catalyst does
+    use utf8;
+    my $body = get('/utf8_non_ascii_content');
+    utf8::decode($body);
+    is $body, 'ʇsʎlɐʇɐɔ', 'Catalyst::Test::get returned content correctly UTF-8 encoded';
+}
+
+done_testing;

diff --git a/t/lib/TestAppEncoding/Controller/Root.pm b/t/lib/TestAppEncoding/Controller/Root.pm
index 095f238..a8987fb 100644 (file)
--- a/t/lib/TestAppEncoding/Controller/Root.pm
+++ b/t/lib/TestAppEncoding/Controller/Root.pm
@@ -24,6 +24,23 @@ sub binary_utf8 : Local {
     $c->res->body($str);
 }
 
+# called by t/aggregate/catalyst_test_utf8.t
+sub utf8_non_ascii_content : Local {
+    use utf8;
+    my ($self, $c) = @_;
+    
+    my $str = 'ʇsʎlɐʇɐɔ';  # 'catalyst' flipped at http://www.revfad.com/flip.html
+    ok utf8::is_utf8($str), '$str is in UTF8 internally';
+    
+    # encode $str into a sequence of octets and turn off the UTF-8 flag, so that
+    # we don't get the 'Wide character in syswrite' error in Catalyst::Engine
+    utf8::encode($str);
+    ok !utf8::is_utf8($str), '$str is a sequence of octets (byte string)';
+    
+    $c->res->body($str);
+}
+
+
 sub end : Private {
     my ($self,$c) = @_;
 }