Commit 94a340f2 authored by David Golden's avatar David Golden

refactor get testing to use external case files

parent 5b14c0a6
......@@ -3,42 +3,33 @@
use strict;
use warnings;
use Test::More qw[no_plan];
use t::Util qw[tmpfile rewind slurp monkey_patch
use Test::More 0.88;
use t::Util qw[tmpfile rewind slurp monkey_patch dir_list
set_socket_source sort_headers $CRLF $LF];
use HTTP::Tiny;
BEGIN { monkey_patch() }
my $data = do { local $/; <DATA> };
my ($expect_req, $give_res) = split /--+\n/, $data;
my $version = HTTP::Tiny->VERSION || 0;
$expect_req =~ s{VERSION}{$version};
for my $case ( dir_list("t/cases", qr/^get/ ) ) {
my $data = do { local (@ARGV,$/) = $case; <> };
my ($url, $expect_req, $give_res) = split /--+\n/, $data;
chomp $url;
my $version = HTTP::Tiny->VERSION || 0;
$expect_req =~ s{VERSION}{$version};
s{\n}{$CRLF}g for ($expect_req, $give_res);
s{\n}{$CRLF}g for ($expect_req, $give_res);
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new;
set_socket_source($req_fh, $res_fh);
my $http = HTTP::Tiny->new;
set_socket_source($req_fh, $res_fh);
my $response = $http->get("http://example.com/index.html");
my $got_req = slurp($req_fh);
my $response = $http->get($url);
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "Request is correct" );
is( $response->{status}, '200', "Response status is correct" )
or diag $response->{content};
is( sort_headers($got_req), sort_headers($expect_req), "get('$url') request" );
is( $response->{status}, '200', "get('$url') response" )
or diag $response->{content};
}
__DATA__
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Thu, 03 Feb 1994 00:00:00 GMT
Content-Type: text/plain
Content-Length: 42
abcdefghijklmnopqrstuvwxyz1234567890abcdef
done_testing;
......@@ -4,11 +4,13 @@ use strict;
use warnings;
use IO::File q[SEEK_SET];
use IO::Dir;
BEGIN {
our @EXPORT_OK = qw(
rewind
tmpfile
dir_list
slurp
sort_headers
set_socket_source
......@@ -47,6 +49,14 @@ sub tmpfile {
return $fh;
}
sub dir_list {
my ($dir, $filter) = @_;
$filter ||= qr/./;
my $d = IO::Dir->new($dir)
or return;
return map { "$dir/$_" } grep { /$filter/ } grep { /^[^.]/ } $d->read;
}
sub slurp (*) {
my ($fh) = @_;
......
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Thu, 03 Feb 1994 00:00:00 GMT
Content-Type: text/plain
Content-Length: 42
abcdefghijklmnopqrstuvwxyz1234567890abcdef
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment