From b275579910d410e7f9ecff88cccdeb673191d332 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 18 Jul 2012 16:43:57 -0500 Subject: import the Plack::Response test suite --- t/response-body.t | 41 +++++++++++++++++++++++++++++++++ t/response-compatible.t | 60 +++++++++++++++++++++++++++++++++++++++++++++++++ t/response-cookie.t | 29 ++++++++++++++++++++++++ t/response-new.t | 41 +++++++++++++++++++++++++++++++++ t/response-redirect.t | 32 ++++++++++++++++++++++++++ t/response.t | 53 +++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 256 insertions(+) create mode 100644 t/response-body.t create mode 100644 t/response-compatible.t create mode 100644 t/response-cookie.t create mode 100644 t/response-new.t create mode 100644 t/response-redirect.t create mode 100644 t/response.t (limited to 't') 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; -- cgit v1.2.3-54-g00ecf