From 0dd83b75d3172b71afbe2de8dbecad4f83d094b3 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 30 Dec 2010 12:18:54 -0600 Subject: refactor tests --- t/01-basic.t | 84 ++++++---------------------------------------- t/lib/Plack/Client/Test.pm | 84 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 94 insertions(+), 74 deletions(-) create mode 100644 t/lib/Plack/Client/Test.pm (limited to 't') diff --git a/t/01-basic.t b/t/01-basic.t index f4cf52a..e138e10 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,86 +1,28 @@ #!/usr/bin/env perl use strict; use warnings; +use lib 't/lib'; use Test::More; -use Test::TCP; +use Plack::Client::Test; -use Plack::Util; - -use Plack::Client; - -sub full_body { - my ($body) = @_; - - return $body unless ref($body); - - my $ret = ''; - Plack::Util::foreach($body, sub { $ret .= $_[0] }); - return $ret; -} - -sub check_headers { - my ($got, $expected) = @_; - local $Test::Builder::Level = $Test::Builder::Level + 1; - - isa_ok($got, 'HTTP::Headers'); - - if (ref($expected) eq 'ARRAY') { - $expected = HTTP::Headers->new(@$expected); - } - elsif (ref($expected) eq 'HASH') { - $expected = HTTP::Headers->new(%$expected); - } - isa_ok($expected, 'HTTP::Headers'); - - my @expected_keys = $expected->header_field_names; - my @got_keys = $got->header_field_names; - - my %default_headers = map { $_ => 1 } qw( - Date Server Content-Length Client-Date Client-Peer Client-Response-Num - ); - my %expected_exists = map { $_ => 1 } @expected_keys; - - for my $header (@expected_keys) { - is($got->header($header), $expected->header($header), - "$header header is the same"); - } - - for my $header (@got_keys) { - next if $default_headers{$header}; - next if $expected_exists{$header}; - fail("got extra header $header"); - } -} - -test_tcp( - client => sub { - my $port = shift; +test_tcp_plackup( + 'sub { [ 200, ["Content-Type" => "text/plain"], [shift->{PATH_INFO}] ] }', + sub { + my $base_url = shift; my $client = Plack::Client->new; isa_ok($client, 'Plack::Client'); - my $base_url = 'http://localhost:' . $port; - { my $res = $client->get($base_url . '/'); - isa_ok($res, 'Plack::Response'); - is($res->status, 200, "right status"); - check_headers($res->headers, ["Content-Type" => "text/plain"]); - is(full_body($res->body), '/', "right body"); + response_is($res, 200, ['Content-Type' => 'text/plain'], '/'); } { my $res = $client->get($base_url . '/foo'); - isa_ok($res, 'Plack::Response'); - is($res->status, 200, "right status"); - check_headers($res->headers, ["Content-Type" => "text/plain"]); - is(full_body($res->body), '/foo', "right body"); + response_is($res, 200, ['Content-Type' => 'text/plain'], '/foo'); } }, - server => sub { - my $port = shift; - exec('plackup', '--port', $port, '-e', 'sub { [ 200, ["Content-Type" => "text/plain"], [shift->{PATH_INFO}] ] }'); - }, ); { @@ -101,18 +43,12 @@ test_tcp( { my $res = $client->get('psgi://foo/'); - isa_ok($res, 'Plack::Response'); - is($res->status, 200, "right status"); - check_headers($res->headers, ["Content-Type" => "text/plain"]); - is(full_body($res->body), '/', "right body"); + response_is($res, 200, ['Content-Type' => 'text/plain'], '/'); } { my $res = $client->get('psgi://foo/foo'); - isa_ok($res, 'Plack::Response'); - is($res->status, 200, "right status"); - check_headers($res->headers, ["Content-Type" => "text/plain"]); - is(full_body($res->body), 'oof/', "right body"); + response_is($res, 200, ['Content-Type' => 'text/plain'], 'oof/'); } } diff --git a/t/lib/Plack/Client/Test.pm b/t/lib/Plack/Client/Test.pm new file mode 100644 index 0000000..65cd867 --- /dev/null +++ b/t/lib/Plack/Client/Test.pm @@ -0,0 +1,84 @@ +package Plack::Client::Test; +use strict; +use warnings; + +use HTTP::Headers; +use Plack::Util; +use Test::More; +use Test::TCP; + +use Plack::Client; + +use Exporter 'import'; +our @EXPORT_OK = qw(full_body check_headers response_is test_tcp_plackup); +our @EXPORT = @EXPORT_OK; + +sub full_body { + my ($body) = @_; + + return $body unless ref($body); + + my $ret = ''; + Plack::Util::foreach($body, sub { $ret .= $_[0] }); + return $ret; +} + +sub check_headers { + my ($got, $expected) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + isa_ok($got, 'HTTP::Headers'); + + if (ref($expected) eq 'ARRAY') { + $expected = HTTP::Headers->new(@$expected); + } + elsif (ref($expected) eq 'HASH') { + $expected = HTTP::Headers->new(%$expected); + } + isa_ok($expected, 'HTTP::Headers'); + + my @expected_keys = $expected->header_field_names; + my @got_keys = $got->header_field_names; + + my %default_headers = map { $_ => 1 } qw( + Date Server Content-Length Client-Date Client-Peer Client-Response-Num + ); + my %expected_exists = map { $_ => 1 } @expected_keys; + + for my $header (@expected_keys) { + is($got->header($header), $expected->header($header), + "$header header is the same"); + } + + for my $header (@got_keys) { + next if $default_headers{$header}; + next if $expected_exists{$header}; + fail("got extra header $header"); + } +} + +sub response_is { + my ($res, $code, $headers, $body) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + isa_ok($res, 'Plack::Response'); + is($res->status, $code, "right status"); + check_headers($res->headers, $headers); + is(full_body($res->body), $body, "right body"); +} + +sub test_tcp_plackup { + my ($server, $client) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + test_tcp( + client => sub { + my $port = shift; + $client->('http://localhost:' . $port); + }, + server => sub { + my $port = shift; + exec('plackup', '--port', $port, '-E', 'foo', '-e', $server); + }, + ) +} + +1; -- cgit v1.2.3-54-g00ecf