about summary refs log tree commit homepage
diff options
context:
space:
mode:
authorEric Wong <BOFH@YHBT.net>2023-06-05 10:12:38 +0000
committerEric Wong <bofh@yhbt.net>2023-06-05 10:38:45 +0000
commitd97e74049f4e989d3061234b1b9cd5f50e7acdd9 (patch)
tree27607a7da7e26001ccbb4c7947023810379f366f
parent74989caa73a84af6dbab29b388ba85ad05ee8119 (diff)
downloadunicorn-d97e74049f4e989d3061234b1b9cd5f50e7acdd9.tar.gz
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.
-rw-r--r--t/active-unix-socket.t13
-rw-r--r--t/integration.t37
-rw-r--r--t/lib.perl30
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 <<EOM;
 pid "$tmpdir/u.pid"
@@ -43,8 +44,8 @@ EOM
 my @uarg = qw(-D -E none t/integration.ru);
 
 # this pipe will be used to notify us when all daemons die:
-pipe(my ($p0, $p1)) or die "pipe: $!";
-fcntl($p1, POSIX::F_SETFD, 0) or die "fcntl: $!"; # clear FD_CLOEXEC
+pipe(my $p0, my $p1);
+fcntl($p1, POSIX::F_SETFD, 0);
 
 # start the first instance
 unicorn('-c', "$tmpdir/u1.conf.rb", @uarg)->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";
 }