xt/stress-sharedkv.t

   1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 use strict;
   4 use v5.10.1;
   5 use Test::More;
   6 use Benchmark qw(:all);
   7 use PublicInbox::TestCommon;
   8 require_ok 'PublicInbox::SharedKV';
   9 my ($tmpdir, $for_destroy) = tmpdir();
  10 local $ENV{TMPDIR} = $tmpdir;
  11 my $skv = PublicInbox::SharedKV->new;
  12 my $ipc = bless {}, 'StressSharedKV';
  13 $ipc->wq_workers_start('stress-sharedkv', $ENV{TEST_NPROC}//4);
  14 my $nr = $ENV{TEST_STRESS_NR} // 100_000;
  15 my $ios = [];
  16 my $t = timeit(1, sub {
  17         for my $i (1..$nr) {
  18                 $ipc->wq_io_do('test_set_maybe', $ios, $skv, $i);
  19                 $ipc->wq_io_do('test_set_maybe', $ios, $skv, $i);
  20         }
  21 });
  22 diag "$nr sets done ".timestr($t);
  23
  24 for my $w ($ipc->wq_workers) {
  25         $ipc->wq_io_do('test_skv_done', $ios);
  26 }
  27 diag "done requested";
  28
  29 $ipc->wq_close;
  30 done_testing;
  31
  32 package StressSharedKV;
  33 use strict;
  34 use v5.10.1;
  35 use parent qw(PublicInbox::IPC);
  36 use Digest::SHA qw(sha1);
  37
  38 sub test_set_maybe {
  39         my ($self, $skv, $i) = @_;
  40         my $wcb = $self->{wcb} //= do {
  41                 $skv->dbh;
  42                 sub { $skv->set_maybe(sha1($_[0]), '') };
  43         };
  44         $wcb->($i + time);
  45 }
  46
  47 sub test_skv_done {
  48         my ($self) = @_;
  49         delete $self->{wcb};
  50 }