From 3a1d015a3859b639d8e4463e9436a49f4f0f720e Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Mon, 5 Jun 2023 10:12:38 +0000 Subject: [PATCH 09/23] tests: use autodie to simplify error checking autodie is bundled with Perl 5.10+ and simplifies error checking in most cases. Some subroutines aren't perfectly translatable and their call sites had to be tweaked, but most of them are. --- t/active-unix-socket.t | 13 +++++++------ t/integration.t | 37 +++++++++++++++++++------------------ t/lib.perl | 30 +++++++++++++++--------------- 3 files changed, 41 insertions(+), 39 deletions(-) diff --git a/t/active-unix-socket.t b/t/active-unix-socket.t index 6b5c218..1241904 100644 --- a/t/active-unix-socket.t +++ b/t/active-unix-socket.t @@ -4,17 +4,18 @@ use v5.14; BEGIN { require './t/lib.perl' }; use IO::Socket::UNIX; +use autodie; +no autodie 'kill'; my %to_kill; END { kill('TERM', values(%to_kill)) if keys %to_kill } my $u1 = "$tmpdir/u1.sock"; my $u2 = "$tmpdir/u2.sock"; my $unix_req = sub { my $s = IO::Socket::UNIX->new(Peer => shift, Type => SOCK_STREAM); - print $s @_, "\r\n\r\n" or die $!; + print $s @_, "\r\n\r\n"; $s; }; { - use autodie; open my $fh, '>', "$tmpdir/u1.conf.rb"; print $fh <join; @@ -93,8 +94,8 @@ is($pidf, $to_kill{u1}, 'pid file contents unchanged after 2nd start failure'); # restart the first instance { - pipe(($p0, $p1)) or die "pipe: $!"; - fcntl($p1, POSIX::F_SETFD, 0) or die "fcntl: $!"; # clear FD_CLOEXEC + pipe($p0, $p1); + fcntl($p1, POSIX::F_SETFD, 0); unicorn('-c', "$tmpdir/u1.conf.rb", @uarg)->join; is($?, 0, 'daemonized 1st process'); chomp($to_kill{u1} = slurp("$tmpdir/u.pid")); diff --git a/t/integration.t b/t/integration.t index 8cef561..af17d51 100644 --- a/t/integration.t +++ b/t/integration.t @@ -5,6 +5,7 @@ # restarting or signals use v5.14; BEGIN { require './t/lib.perl' }; +use autodie; my $srv = tcp_server(); my $host_port = tcp_host_port($srv); my $t0 = time; @@ -34,7 +35,7 @@ Trailer: Content-MD5\r EOM my ($buf, $r); while (1) { - $r = read($in, $buf, $bs) // die "read: $!"; + $r = read($in, $buf, $bs); last if $r == 0; printf $out "%x\r\n", length($buf); print $out $buf, "\r\n"; @@ -54,7 +55,7 @@ EOM my ($buf, $r, $len); while ($clen) { $len = $clen > $bs ? $bs : $clen; - $r = read($in, $buf, $len) // die "read: $!"; + $r = read($in, $buf, $len); die 'premature EOF' if $r == 0; print $out $buf; $clen -= $r; @@ -130,28 +131,28 @@ if ('bad requests') { like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request'); $c = tcp_connect($srv); - print $c 'GET /' or die $!; + print $c 'GET /'; my $buf = join('', (0..9), 'ab'); - for (0..1023) { print $c $buf or die $! } - print $c " HTTP/1.0\r\n\r\n" or die $!; + for (0..1023) { print $c $buf } + print $c " HTTP/1.0\r\n\r\n"; ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on REQUEST_PATH > (12 * 1024)'); $c = tcp_connect($srv); - print $c 'GET /hello-world?a' or die $!; + print $c 'GET /hello-world?a'; $buf = join('', (0..9)); - for (0..1023) { print $c $buf or die $! } - print $c " HTTP/1.0\r\n\r\n" or die $!; + for (0..1023) { print $c $buf } + print $c " HTTP/1.0\r\n\r\n"; ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on QUERY_STRING > (10 * 1024)'); $c = tcp_connect($srv); - print $c 'GET /hello-world#a' or die $!; + print $c 'GET /hello-world#a'; $buf = join('', (0..9), 'a'..'f'); - for (0..63) { print $c $buf or die $! } - print $c " HTTP/1.0\r\n\r\n" or die $!; + for (0..63) { print $c $buf } + print $c " HTTP/1.0\r\n\r\n"; ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on FRAGMENT > (1024)'); } @@ -159,7 +160,7 @@ if ('bad requests') { # input tests my ($blob_size, $blob_hash); SKIP: { - open(my $rh, '<', 't/random_blob') or + CORE::open(my $rh, '<', 't/random_blob') or skip "t/random_blob not generated $!", 1; $blob_size = -s $rh; require Digest::SHA; @@ -167,11 +168,11 @@ SKIP: { my $ck_hash = sub { my ($sub, $path, %opt) = @_; - seek($rh, 0, SEEK_SET) // die "seek: $!"; + seek($rh, 0, SEEK_SET); $c = tcp_connect($srv); $c->autoflush(0); $PUT{$sub}->($rh, $c, $path, %opt); - $c->flush or die "flush: $!"; + $c->flush or die $!; ($status, $hdr) = slurp_hdr($c); is(readline($c), $blob_hash, "$sub $path"); }; @@ -189,10 +190,10 @@ SKIP: { my $url = "http://$host_port/rack_input"; my $do_curl = sub { my (@arg) = @_; - pipe(my $cout, $copt->{1}) or die "pipe: $!"; - open $copt->{2}, '>', "$tmpdir/curl.err" or die $!; + pipe(my $cout, $copt->{1}); + open $copt->{2}, '>', "$tmpdir/curl.err"; my $cpid = spawn($curl, '-sSf', @arg, $url, $copt); - close(delete $copt->{1}) or die "close: $!"; + close(delete $copt->{1}); is(readline($cout), $blob_hash, "curl @arg response"); is(waitpid($cpid, 0), $cpid, "curl @arg exited"); is($?, 0, "no error from curl @arg"); @@ -201,7 +202,7 @@ SKIP: { $do_curl->(qw(-T t/random_blob)); - seek($rh, 0, SEEK_SET) // die "seek: $!"; + seek($rh, 0, SEEK_SET); $copt->{0} = $rh; $do_curl->('-T-'); } diff --git a/t/lib.perl b/t/lib.perl index ae9f197..49632cf 100644 --- a/t/lib.perl +++ b/t/lib.perl @@ -4,6 +4,7 @@ package UnicornTest; use v5.14; use parent qw(Exporter); +use autodie; use Test::More; use IO::Socket::INET; use POSIX qw(dup2 _exit setpgid :signal_h SEEK_SET F_SETFD); @@ -14,7 +15,7 @@ our @EXPORT = qw(unicorn slurp tcp_server tcp_connect unicorn $tmpdir $errfh my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!); $tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1); -open($errfh, '>>', "$tmpdir/err.log") or die "open: $!"; +open($errfh, '>>', "$tmpdir/err.log"); sub tcp_server { my %opt = ( @@ -62,14 +63,14 @@ sub tcp_connect { sub start_req { my ($srv, @req) = @_; my $c = tcp_connect($srv); - print $c @req, "\r\n\r\n" or die "print: $!"; + print $c @req, "\r\n\r\n"; $c; } sub slurp { - open my $fh, '<', $_[0] or die "open($_[0]): $!"; + open my $fh, '<', $_[0]; local $/; - <$fh>; + readline($fh); } sub spawn { @@ -80,8 +81,8 @@ sub spawn { my $set = POSIX::SigSet->new; $set->fillset or die "sigfillset: $!"; sigprocmask(SIG_SETMASK, $set, $old) or die "SIG_SETMASK: $!"; - pipe(my ($r, $w)) or die "pipe: $!"; - my $pid = fork // die "fork: $!"; + pipe(my $r, my $w); + my $pid = fork; if ($pid == 0) { close $r; $SIG{__DIE__} = sub { @@ -94,9 +95,9 @@ sub spawn { my $cfd; for ($cfd = 0; ($cfd < 3) || defined($opt->{$cfd}); $cfd++) { my $io = $opt->{$cfd} // next; - my $pfd = fileno($io) // die "fileno($io): $!"; + my $pfd = fileno($io); if ($pfd == $cfd) { - fcntl($io, F_SETFD, 0) // die "F_SETFD: $!"; + fcntl($io, F_SETFD, 0); } else { dup2($pfd, $cfd) // die "dup2($pfd, $cfd): $!"; } @@ -110,9 +111,7 @@ sub spawn { setpgid(0, $pgid) // die "setpgid(0, $pgid): $!"; } $SIG{$_} = 'DEFAULT' for grep(!/^__/, keys %SIG); - if (defined(my $cd = $opt->{-C})) { - chdir $cd // die "chdir($cd): $!"; - } + if (defined(my $cd = $opt->{-C})) { chdir $cd } $old->delset(POSIX::SIGCHLD) or die "sigdelset CHLD: $!"; sigprocmask(SIG_SETMASK, $old) or die "SIG_SETMASK: ~CHLD: $!"; @ENV{keys %$env} = values(%$env) if $env; @@ -162,22 +161,23 @@ sub unicorn { # automatically kill + reap children when this goes out-of-scope package UnicornTest::AutoReap; use v5.14; +use autodie; sub new { my (undef, $pid) = @_; bless { pid => $pid, owner => $$ }, __PACKAGE__ } -sub kill { +sub do_kill { my ($self, $sig) = @_; - CORE::kill($sig // 'TERM', $self->{pid}); + kill($sig // 'TERM', $self->{pid}); } sub join { my ($self, $sig) = @_; my $pid = delete $self->{pid} or return; - CORE::kill($sig, $pid) if defined $sig; - my $ret = waitpid($pid, 0) // die "waitpid($pid): $!"; + kill($sig, $pid) if defined $sig; + my $ret = waitpid($pid, 0); $ret == $pid or die "BUG: waitpid($pid) != $ret"; }