t/mbox_lock.t

   1 #!perl -w
   2 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict; use v5.10.1; use PublicInbox::TestCommon;
   5 use POSIX qw(_exit);
   6 use PublicInbox::DS qw(now);
   7 use Errno qw(EAGAIN);
   8 use_ok 'PublicInbox::MboxLock';
   9 my ($tmpdir, $for_destroy) = tmpdir();
  10 my $f = "$tmpdir/f";
  11 my $mbl = PublicInbox::MboxLock->acq($f, 1, ['dotlock']);
  12 ok(-f "$f.lock", 'dotlock created');
  13 undef $mbl;
  14 ok(!-f "$f.lock", 'dotlock gone');
  15 $mbl = PublicInbox::MboxLock->acq($f, 1, ['none']);
  16 ok(!-f "$f.lock", 'no dotlock with none');
  17 undef $mbl;
  18
  19 eval {
  20         PublicInbox::MboxLock->acq($f, 1, ['bogus']);
  21         fail "should not succeed with `bogus'";
  22 };
  23 ok($@, "fails on `bogus' lock method");
  24 eval {
  25         PublicInbox::MboxLock->acq($f, 1, ['timeout=1']);
  26         fail "should not succeed with only timeout";
  27 };
  28 ok($@, "fails with only `timeout=' and no lock method");
  29
  30 my $defaults = PublicInbox::MboxLock->defaults;
  31 is(ref($defaults), 'ARRAY', 'default lock methods');
  32 my $test_rw_lock = sub {
  33         my ($func) = @_;
  34         my $m = ["$func,timeout=0.000001"];
  35         for my $i (1..2) {
  36                 pipe(my ($r, $w)) or BAIL_OUT "pipe: $!";
  37                 my $t0 = now;
  38                 my $pid = fork // BAIL_OUT "fork $!";
  39                 if ($pid == 0) {
  40                         eval { PublicInbox::MboxLock->acq($f, 1, $m) };
  41                         my $err = $@;
  42                         syswrite $w, "E: $err";
  43                         _exit($err ? 0 : 1);
  44                 }
  45                 undef $w;
  46                 waitpid($pid, 0);
  47                 is($?, 0, "$func r/w lock behaved as expected #$i");
  48                 my $d = now - $t0;
  49                 ok($d < 1, "$func r/w timeout #$i") or diag "elapsed=$d";
  50                 my $err = do { local $/; <$r> };
  51                 $! = EAGAIN;
  52                 my $msg = "$!";
  53                 like($err, qr/\Q$msg\E/, "got EAGAIN in child #$i");
  54         }
  55 };
  56
  57 my $test_ro_lock = sub {
  58         my ($func) = @_;
  59         for my $i (1..2) {
  60                 my $t0 = now;
  61                 my $pid = fork // BAIL_OUT "fork $!";
  62                 if ($pid == 0) {
  63                         eval { PublicInbox::MboxLock->acq($f, 0, [ $func ]) };
  64                         _exit($@ ? 1 : 0);
  65                 }
  66                 waitpid($pid, 0);
  67                 is($?, 0, "$func ro lock behaved as expected #$i");
  68                 my $d = now - $t0;
  69                 ok($d < 1, "$func timeout respected #$i") or diag "elapsed=$d";
  70         }
  71 };
  72
  73 SKIP: {
  74         grep(/fcntl/, @$defaults) or skip 'File::FcntlLock not available', 1;
  75         my $top = PublicInbox::MboxLock->acq($f, 1, $defaults);
  76         ok($top, 'fcntl lock acquired');
  77         $test_rw_lock->('fcntl');
  78         undef $top;
  79         $top = PublicInbox::MboxLock->acq($f, 0, $defaults);
  80         ok($top, 'fcntl read lock acquired');
  81         $test_ro_lock->('fcntl');
  82 }
  83 $mbl = PublicInbox::MboxLock->acq($f, 1, ['flock']);
  84 ok($mbl, 'flock acquired');
  85 $test_rw_lock->('flock');
  86 undef $mbl;
  87 $mbl = PublicInbox::MboxLock->acq($f, 0, ['flock']);
  88 $test_ro_lock->('flock');
  89
  90 done_testing;