refactor tests

2 files changed, 94 insertions, 74 deletions

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;