tests: introduce `do_req' helper sub

While early tests required fine-grained control in trickling
requests, many of our later tests can use a short one-liner
w/o having to spawn curl.

7 files changed, 44 insertions, 61 deletions

diff --git a/t/heartbeat-timeout.t b/t/heartbeat-timeout.t
index 1fcf21a..ce1f7e1 100644
--- a/t/heartbeat-timeout.t
+++ b/t/heartbeat-timeout.t
@@ -18,10 +18,8 @@ close $fh;
 
 my $ar = unicorn(qw(-E none t/heartbeat-timeout.ru -c), $u_conf, { 3 => $srv });
 
-my $c = tcp_start($srv, 'GET /pid HTTP/1.0');
-my ($status, $hdr) = slurp_hdr($c);
+my ($status, $hdr, $wpid) = do_req($srv, 'GET /pid HTTP/1.0');
 like($status, qr!\AHTTP/1\.[01] 200\b!, 'PID request succeeds');
-my $wpid = do { local $/; <$c> };
 like($wpid, qr/\A[0-9]+\z/, 'worker is running');
 
 my $t0 = clock_gettime(CLOCK_MONOTONIC);
@@ -39,10 +37,8 @@ is(grep(/timeout \(\d+s > 3s\), killing/, @timeout_err), 1,
     'noted timeout error') or diag explain(\@timeout_err);
 
 # did it respawn?
-$c = tcp_start($srv, 'GET /pid HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
+($status, $hdr, my $new_pid) = do_req($srv, 'GET /pid HTTP/1.0');
 like($status, qr!\AHTTP/1\.[01] 200\b!, 'PID request succeeds');
-my $new_pid = do { local $/; <$c> };
 isnt($new_pid, $wpid, 'spawned new worker');
 
 diag 'SIGSTOP for 4 seconds...';
@@ -50,11 +46,9 @@ $ar->do_kill('STOP');
 sleep 4;
 $ar->do_kill('CONT');
 for my $i (1..2) {
-        $c = tcp_start($srv, 'GET /pid HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr, my $spid) = do_req($srv, 'GET /pid HTTP/1.0');
         like($status, qr!\AHTTP/1\.[01] 200\b!,
                 "PID request succeeds #$i after STOP+CONT");
-        my $spid = do { local $/; <$c> };
         is($new_pid, $spid, "worker pid unchanged after STOP+CONT #$i");
         if ($i == 1) {
                 diag 'sleeping 2s to ensure timeout is not delayed';
diff --git a/t/integration.t b/t/integration.t
index bb2ab51..13b0746 100644
--- a/t/integration.t
+++ b/t/integration.t
@@ -62,11 +62,10 @@ EOM
         },
 );
 
-my ($c, $status, $hdr);
+my ($c, $status, $hdr, $bdy);
 
 # response header tests
-$c = tcp_start($srv, 'GET /rack-2-newline-headers HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
+($status, $hdr) = do_req($srv, 'GET /rack-2-newline-headers HTTP/1.0');
 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid');
 my $orig_200_status = $status;
 is_deeply([ grep(/^X-R2: /, @$hdr) ],
@@ -84,16 +83,16 @@ SKIP: { # Date header check
 };
 
 
-$c = tcp_start($srv, 'GET /rack-3-array-headers HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
+($status, $hdr) = do_req($srv, 'GET /rack-3-array-headers HTTP/1.0');
 is_deeply([ grep(/^x-r3: /, @$hdr) ],
         [ 'x-r3: a', 'x-r3: b', 'x-r3: c' ],
         'rack 3 array headers supported') or diag(explain($hdr));
 
 SKIP: {
         eval { require JSON::PP } or skip "JSON::PP missing: $@", 1;
-        my $c = tcp_start($srv, 'GET /env_dump');
-        my $json = do { local $/; readline($c) };
+        ($status, $hdr, my $json) = do_req $srv, 'GET /env_dump';
+        is($status, undef, 'no status for HTTP/0.9');
+        is($hdr, undef, 'no header for HTTP/0.9');
         unlike($json, qr/^Connection: /smi, 'no connection header for 0.9');
         unlike($json, qr!\AHTTP/!s, 'no HTTP/1.x prefix for 0.9');
         my $env = JSON::PP->new->decode($json);
@@ -102,8 +101,7 @@ SKIP: {
 }
 
 # cf. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
-$c = tcp_start($srv, 'GET /nil-header-value HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
+($status, $hdr) = do_req($srv, 'GET /nil-header-value HTTP/1.0');
 is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '],
         'nil header value accepted for broken apps') or diag(explain($hdr));
 
@@ -128,12 +126,10 @@ my $ck_early_hints = sub {
 $ck_early_hints->('ccc off'); # we'll retest later
 
 if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') {
-        $c = tcp_start($srv, 'POST /tweak-status-code HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr) = do_req $srv, 'POST /tweak-status-code HTTP/1.0';
         like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked');
 
-        $c = tcp_start($srv, 'POST /restore-status-code HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr) = do_req $srv, 'POST /restore-status-code HTTP/1.0';
         is($status, $orig_200_status, 'original status restored');
 }
 
@@ -145,12 +141,11 @@ SKIP: {
 }
 
 if ('bad requests') {
-        $c = tcp_start($srv, 'GET /env_dump HTTP/1/1');
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr) = do_req $srv, 'GET /env_dump HTTP/1/1';
         like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request');
 
         $c = tcp_start($srv);
-        print $c 'GET /';;
+        print $c 'GET /';
         my $buf = join('', (0..9), 'ab');
         for (0..1023) { print $c $buf }
         print $c " HTTP/1.0\r\n\r\n";
@@ -308,12 +303,10 @@ EOM
         $wpid =~ s/\Apid=// or die;
         ok(CORE::kill(0, $wpid), 'worker PID retrieved');
 
-        $c = tcp_start($srv, $req);
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr) = do_req($srv, $req);
         like($status, qr!\AHTTP/1\.[01] 200\b!, 'minimal request succeeds');
 
-        $c = tcp_start($srv, 'GET /xxxxxx HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
+        ($status, $hdr) = do_req($srv, 'GET /xxxxxx HTTP/1.0');
         like($status, qr!\AHTTP/1\.[01] 413\b!, 'big request fails');
 }
 
diff --git a/t/lib.perl b/t/lib.perl
index 7de9e42..13e390d 100644
--- a/t/lib.perl
+++ b/t/lib.perl
@@ -12,7 +12,8 @@ use File::Temp 0.19 (); # 0.19 for ->newdir
 our ($tmpdir, $errfh, $err_log);
 our @EXPORT = qw(unicorn slurp tcp_server tcp_start unicorn
         $tmpdir $errfh $err_log
-        SEEK_SET tcp_host_port which spawn check_stderr unix_start slurp_hdr);
+        SEEK_SET tcp_host_port which spawn check_stderr unix_start slurp_hdr
+        do_req);
 
 my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
 $tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1);
@@ -182,6 +183,19 @@ sub unicorn {
         UnicornTest::AutoReap->new($pid);
 }
 
+sub do_req ($@) {
+        my ($dst, @req) = @_;
+        my $c = ref($dst) ? tcp_start($dst, @req) : unix_start($dst, @req);
+        return $c if !wantarray;
+        my ($status, $hdr);
+        # read headers iff HTTP/1.x request, HTTP/0.9 remains supported
+        my ($first) = (join('', @req) =~ m!\A([^\r\n]+)!);
+        ($status, $hdr) = slurp_hdr($c) if $first =~ m{\s*HTTP/\S+$};
+        my $bdy = do { local $/; <$c> };
+        close $c;
+        ($status, $hdr, $bdy);
+}
+
 # automatically kill + reap children when this goes out-of-scope
 package UnicornTest::AutoReap;
 use v5.14;
diff --git a/t/reload-bad-config.t b/t/reload-bad-config.t
index c7055c7..543421d 100644
--- a/t/reload-bad-config.t
+++ b/t/reload-bad-config.t
@@ -25,9 +25,7 @@ EOM
 close $fh;
 
 my $ar = unicorn(qw(-E none -c), $u_conf, $ru, { 3 => $srv });
-my $c = tcp_start($srv, 'GET / HTTP/1.0');
-my ($status, $hdr) = slurp_hdr($c);
-my $bdy = do { local $/; <$c> };
+my ($status, $hdr, $bdy) = do_req($srv, 'GET / HTTP/1.0');
 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid at start');
 is($bdy, "hello world\n", 'body matches expected');
 
@@ -47,9 +45,7 @@ ok(grep(/error reloading/, @l), 'got error reloading');
 open $fh, '>', $err_log;
 close $fh;
 
-$c = tcp_start($srv, 'GET / HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
-$bdy = do { local $/; <$c> };
+($status, $hdr, $bdy) = do_req($srv, 'GET / HTTP/1.0');
 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid afte reload');
 is($bdy, "hello world\n", 'body matches expected after reload');
 
diff --git a/t/reopen-logs.t b/t/reopen-logs.t
index e1bf524..8a58c1b 100644
--- a/t/reopen-logs.t
+++ b/t/reopen-logs.t
@@ -14,9 +14,7 @@ EOM
 close $fh;
 
 my $auto_reap = unicorn('-c', $u_conf, 't/reopen-logs.ru', { 3 => $srv } );
-my $c = tcp_start($srv, 'GET / HTTP/1.0');
-my ($status, $hdr) = slurp_hdr($c);
-my $bdy = do { local $/; <$c> };
+my ($status, $hdr, $bdy) = do_req($srv, 'GET / HTTP/1.0');
 is($bdy, "true\n", 'logs opened');
 
 rename($err_log, "$err_log.rot");
@@ -31,9 +29,7 @@ while (!-f $out_log && --$tries) { select undef, undef, undef, 0.01 };
 ok(-f $out_log, 'stdout_path recreated after USR1');
 ok(-f $err_log, 'stderr_path recreated after USR1');
 
-$c = tcp_start($srv, 'GET / HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
-$bdy = do { local $/; <$c> };
+($status, $hdr, $bdy) = do_req($srv, 'GET / HTTP/1.0');
 is($bdy, "true\n", 'logs reopened with sync==true');
 
 $auto_reap->join('QUIT');
diff --git a/t/winch_ttin.t b/t/winch_ttin.t
index 1a19877..509b118 100644
--- a/t/winch_ttin.t
+++ b/t/winch_ttin.t
@@ -34,10 +34,8 @@ my $worker_nr = <$fh>;
 close $fh;
 is($worker_nr, '0', 'initial worker spawned');
 
-my $c = unix_start($u_sock, 'GET /pid HTTP/1.0');
-my ($status, $hdr) = slurp_hdr($c);
+my ($status, $hdr, $worker_pid) = do_req($u_sock, 'GET /pid HTTP/1.0');
 like($status, qr/ 200\b/, 'got 200 response');
-my $worker_pid = do { local $/; <$c> };
 like($worker_pid, qr/\A[0-9]+\n\z/s, 'PID in response');
 chomp $worker_pid;
 ok(kill(0, $worker_pid), 'worker_pid is valid');
@@ -57,11 +55,10 @@ $worker_nr = <$fh>;
 close $fh;
 is($worker_nr, '0', 'worker restarted');
 
-$c = unix_start($u_sock, 'GET /pid HTTP/1.0');
-($status, $hdr) = slurp_hdr($c);
+($status, $hdr, my $new_worker_pid) = do_req($u_sock, 'GET /pid HTTP/1.0');
 like($status, qr/ 200\b/, 'got 200 response');
-chomp(my $new_worker_pid = do { local $/; <$c> });
-like($new_worker_pid, qr/\A[0-9]+\z/, 'got new worker PID');
+like($new_worker_pid, qr/\A[0-9]+\n\z/, 'got new worker PID');
+chomp $new_worker_pid;
 ok(kill(0, $new_worker_pid), 'got a valid worker PID');
 isnt($worker_pid, $new_worker_pid, 'worker PID changed');
 
diff --git a/t/working_directory.t b/t/working_directory.t
index e7ff43a..6c97472 100644
--- a/t/working_directory.t
+++ b/t/working_directory.t
@@ -52,10 +52,8 @@ END { $stop_daemon->(1) if defined $pid };
 unicorn('-c', $u_conf)->join; # will daemonize
 chomp($pid = slurp("$tmpdir/pid"));
 
-my $c = unix_start($u_sock, 'GET / HTTP/1.0');
-my ($status, $hdr) = slurp_hdr($c);
-chomp(my $bdy = do { local $/; <$c> });
-is($bdy, 1, 'got expected $master_ppid');
+my ($status, $hdr, $bdy) = do_req($u_sock, 'GET / HTTP/1.0');
+is($bdy, "1\n", 'got expected $master_ppid');
 
 $stop_daemon->();
 check_stderr;
@@ -69,10 +67,8 @@ if ('test without CLI switches in config.ru') {
         unicorn('-D', '-l', $u_sock, '-c', $u_conf)->join; # will daemonize
         chomp($pid = slurp("$tmpdir/pid"));
 
-        $c = unix_start($u_sock, 'GET / HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
-        chomp($bdy = do { local $/; <$c> });
-        is($bdy, 1, 'got expected $master_ppid');
+        ($status, $hdr, $bdy) = do_req($u_sock, 'GET / HTTP/1.0');
+        is($bdy, "1\n", 'got expected $master_ppid');
 
         $stop_daemon->();
         check_stderr;
@@ -107,12 +103,9 @@ EOM
         my $srv = tcp_server;
         my $auto_reap = unicorn(qw(-c), $u_conf, qw(-I. fooapp.rb),
                                 { -C => '/', 3 => $srv });
-        $c = tcp_start($srv, 'GET / HTTP/1.0');
-        ($status, $hdr) = slurp_hdr($c);
-        chomp($bdy = do { local $/; <$c> });
+        ($status, $hdr, $bdy) = do_req($srv, 'GET / HTTP/1.0');
         is($bdy, "dir=$tmpdir/alt",
                 'fooapp.rb (w/o config.ru) w/ working_directory');
-        close $c;
         $auto_reap->join('TERM');
         is($?, 0, 'fooapp.rb process exited');
         check_stderr;