diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-12-30 16:40:22 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-12-30 16:40:22 -0600 |
commit | 934a64b7706ec6092c0b2197f46dcdea82ff5192 (patch) | |
tree | d941ecbbb33584cbc1254d10534c1ac018c8e9b8 | |
parent | acf44d5b9b15366839fac63cc15e1b2b9d5d8369 (diff) | |
download | plack-client-934a64b7706ec6092c0b2197f46dcdea82ff5192.tar.gz plack-client-934a64b7706ec6092c0b2197f46dcdea82ff5192.zip |
more tests
-rw-r--r-- | t/02-inputs.t | 99 |
1 files changed, 99 insertions, 0 deletions
diff --git a/t/02-inputs.t b/t/02-inputs.t new file mode 100644 index 0000000..bafe960 --- /dev/null +++ b/t/02-inputs.t @@ -0,0 +1,99 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use lib 't/lib'; +use Test::More; +use Plack::Client::Test; + +my $app = <<'APP'; +sub { + my $env = shift; + return [ + 200, + ['Content-Type' => 'text/plain'], + [ + (map { ($env->{$_} || '') . "\n" } + qw( + REQUEST_METHOD + REQUEST_URI + CONTENT_LENGTH + )), + (map { ucfirst(lc) . ': ' . $env->{"HTTP_X_$_"} . "\n" } + grep { $_ ne 'FORWARDED_FOR' } grep { s/^HTTP_X_// } + keys %$env), + do { + my $fh = $env->{'psgi.input'}; + $fh->read(my $body, $env->{CONTENT_LENGTH}); + $body; + }, + ] + ]; +} +APP + +test_tcp_plackup( + $app, + sub { + my $base_uri = shift; + + test_responses($base_uri, Plack::Client->new); + }, +); + +{ + my $apps = { + foo => eval $app, + }; + my $base_uri = 'psgi://foo'; + + test_responses($base_uri, Plack::Client->new(apps => $apps)); +} + +sub test_responses { + my ($base_uri, $client) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + response_is( + $client->get($base_uri), + 200, + ['Content-Type' => 'text/plain'], + "GET\n/\n\n" + ); + + response_is( + $client->get($base_uri . '/'), + 200, + ['Content-Type' => 'text/plain'], + "GET\n/\n\n" + ); + + response_is( + $client->get($base_uri . '/foo'), + 200, + ['Content-Type' => 'text/plain'], + "GET\n/foo\n\n" + ); + + response_is( + $client->get($base_uri . '/foo', ['X-Foo' => 'bar']), + 200, + ['Content-Type' => 'text/plain'], + "GET\n/foo\n\nFoo: bar\n" + ); + + response_is( + $client->get($base_uri . '/foo', HTTP::Headers->new('X-Foo' => 'bar')), + 200, + ['Content-Type' => 'text/plain'], + "GET\n/foo\n\nFoo: bar\n" + ); + + response_is( + $client->post($base_uri, [], "foo"), + 200, + ['Content-Type' => 'text/plain'], + "POST\n/\n3\nfoo", + ); +} + +done_testing; |