import the Plack::Response test suite

6 files changed, 256 insertions, 0 deletions

diff --git a/t/response-body.t b/t/response-body.t
new file mode 100644
index 0000000..39e2e03
--- /dev/null
+++ b/t/response-body.t
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use File::Temp;
+use FindBin;
+use URI;
+use Web::Response;
+
+sub r($) {
+    my $res = Web::Response->new(status => 200);
+    $res->body(@_);
+    return $res->finalize->[2];
+}
+
+is_deeply r "Hello World", [ "Hello World" ];
+is_deeply r [ "Hello", "World" ], [ "Hello", "World" ];
+
+{
+    open my $fh, "$FindBin::Bin/body.t";
+    is_deeply r $fh, $fh;
+}
+
+{
+    my $foo = "bar";
+    open my $io, "<", \$foo;
+    is_deeply r $io, $io;
+}
+
+{
+    my $uri = URI->new("foo"); # stringified object
+    is_deeply r $uri, [ $uri ];
+}
+
+{
+    my $tmp = File::Temp->new; # File::Temp has stringify method, but it is-a IO::Handle.
+    is_deeply r $tmp, $tmp;
+}
+
+done_testing;
diff --git a/t/response-compatible.t b/t/response-compatible.t
new file mode 100644
index 0000000..9fa8e54
--- /dev/null
+++ b/t/response-compatible.t
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Response;
+
+{
+    my $res = Web::Response->new;
+    $res->status(200);
+    $res->header("Foo:Bar" => "baz");
+    $res->body("Hello");
+
+    is_deeply $res->finalize, [ 200, [ 'Foo:Bar' => 'baz' ], ["Hello"] ];
+}
+
+{
+    my $res = Web::Response->new;
+    $res->status(200);
+    $res->header("Foo\000Bar" => "baz");
+    $res->header("Qux\177Quux" => "42");
+    $res->body("Hello");
+
+    is_deeply $res->finalize, [ 200, [ "Foo\000Bar" => 'baz', "Qux\177Quux" => '42' ], ["Hello"] ];
+}
+
+{
+    my $res = Web::Response->new;
+    $res->status(200);
+    $res->header("X-LWS-I"  => "Bar\r\n  true");
+    $res->header("X-LWS-II" => "Bar\r\n\t\ttrue");
+    $res->body("Hello");
+
+    is_deeply $res->finalize,
+        [
+            200,
+            [ 'X-LWS-I' => 'Bar true', 'X-LWS-II' => 'Bar true' ],
+            ["Hello"]
+        ];
+}
+
+{
+    my $res = Web::Response->new;
+    $res->status(200);
+    $res->header("X-CR-LF" => "Foo\nBar\rBaz");
+    $res->body("Hello");
+
+    is_deeply $res->finalize, [ 200, [ 'X-CR-LF' => 'FooBarBaz' ], ["Hello"] ];
+}
+
+{
+    my $res = Web::Response->new;
+    $res->status(200);
+    $res->header("X-CR-LF" => "Foo\nBar\rBaz");
+    $res->body("Hello");
+
+    is_deeply $res->finalize, [ 200, [ 'X-CR-LF' => 'FooBarBaz' ], ["Hello"] ];
+}
+
+done_testing;
diff --git a/t/response-cookie.t b/t/response-cookie.t
new file mode 100644
index 0000000..c9d35ee
--- /dev/null
+++ b/t/response-cookie.t
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Response;
+
+my $app = sub {
+    my $res = Web::Response->new(status => 200);
+
+    $res->cookies->{t1} = { value => "bar", domain => '.example.com', path => '/cgi-bin' };
+    $res->cookies->{t2} = { value => "xxx yyy", expires => time + 3600 };
+    $res->cookies->{t3} = { value => "123123", "max-age" => 15 };
+    $res->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    my $res = $cb->(GET "/");
+
+    my @v = sort $res->header('Set-Cookie');
+    is $v[0], "t1=bar; domain=.example.com; path=/cgi-bin";
+    like $v[1], qr/t2=xxx%20yyy; expires=\w+, \d+-\w+-\d+ \d\d:\d\d:\d\d GMT/;
+    is $v[2], "t3=123123; max-age=15";
+};
+
+done_testing;
diff --git a/t/response-new.t b/t/response-new.t
new file mode 100644
index 0000000..d78d1ad
--- /dev/null
+++ b/t/response-new.t
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Response;
+
+{
+    my $res = Web::Response->new(status => 302);
+    is $res->status, 302;
+}
+
+{
+    my $res = Web::Response->new(
+        status  => 200,
+        headers => [ 'Content-Type' => 'text/plain' ],
+    );
+    is $res->content_type, 'text/plain';
+}
+
+{
+    my $res = Web::Response->new(
+        status  => 200,
+        headers => { 'Content-Type' => 'text/plain' },
+    );
+    is $res->content_type, 'text/plain';
+}
+
+{
+    my $res = Web::Response->new(status => 200);
+    $res->content_type('image/png');
+    is $res->content_type, 'image/png';
+}
+
+{
+    my $res = Web::Response->new(status => 200);
+    $res->header('X-Foo' => "bar");
+    is $res->header('X-Foo'), "bar";
+}
+
+done_testing;
diff --git a/t/response-redirect.t b/t/response-redirect.t
new file mode 100644
index 0000000..5e6f356
--- /dev/null
+++ b/t/response-redirect.t
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Response;
+
+{
+    my $res = Web::Response->new;
+    $res->redirect('http://www.google.com/');
+    is $res->location, 'http://www.google.com/';
+    is $res->status, 302;
+
+    is_deeply $res->finalize, [ 302, [ 'Location' => 'http://www.google.com/' ], [] ];
+}
+
+{
+    my $res = Web::Response->new;
+    $res->redirect('http://www.google.com/', 301);
+    is_deeply $res->finalize, [ 301, [ 'Location' => 'http://www.google.com/' ], [] ];
+}
+
+{
+    my $uri_invalid = "http://www.google.com/\r\nX-Injection: true\r\n\r\nHello World";
+
+    my $res = Web::Response->new;
+    $res->redirect($uri_invalid, 301);
+    my $psgi_res = $res->finalize;
+    ok $psgi_res->[1][1] !~ /\n/;
+}
+
+done_testing;
diff --git a/t/response.t b/t/response.t
new file mode 100644
index 0000000..a189c4d
--- /dev/null
+++ b/t/response.t
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Response;
+
+sub res {
+    my $res = Web::Response->new;
+    my %v = @_;
+    while (my($k, $v) = each %v) {
+        $res->$k($v);
+    }
+    $res->finalize;
+}
+
+is_deeply(
+    res(
+        status => 200,
+        body => 'hello',
+    ),
+    [ 200, +[], [ 'hello' ] ]
+);
+is_deeply(
+    res(
+        status => 200,
+        cookies => +{
+            'foo_sid' => +{
+                value => 'ASDFJKL:',
+                expires => 'Thu, 25-Apr-1999 00:40:33 GMT',
+                domain  => 'example.com',
+                path => '/',
+            },
+            'poo_sid' => +{
+                value => 'QWERTYUI',
+                expires => 'Thu, 25-Apr-1999 00:40:33 GMT',
+                domain  => 'example.com',
+                path => '/',
+            },
+        },
+        body   => 'hello',
+    ),
+    [
+        200,
+        +[
+            'Set-Cookie' => 'poo_sid=QWERTYUI; domain=example.com; path=/; expires=Thu, 25-Apr-1999 00:40:33 GMT',
+            'Set-Cookie' => 'foo_sid=ASDFJKL%3A; domain=example.com; path=/; expires=Thu, 25-Apr-1999 00:40:33 GMT',
+        ],
+        [ 'hello' ],
+    ]
+);
+
+done_testing;