perl - 如何在 Perl 中测试对资源(缓存)的并发访问？

Question

我如何测试该资源(基于文件的缓存，用于在 Perl 中缓存 webapp 的输出)在并发访问所述共享资源时表现正常？

我写了一个简单的基于文件的缓存，用 Perl 编写，它使用锁定来序列化写访问，即只有一个进程(重新)生成缓存条目。如果重要，此缓存将用于缓存 Perl webapp (gitweb) 的输出。

我想测试所述缓存在并发访问下是否正常运行，例如，只有一个进程会运行用于生成缓存的子例程 ($cache->compute($key, sub { ... } ))，所有进程都将获得生成的数据，如果写入缓存条目的进程死亡，则不会死锁进程等待(重新)生成缓存等。

我应该怎么做？是否有现成的 Perl 模块可供我使用？

Answer 1

最后我的工作基于Unix for Perl programmers: pipes and processes通过亚伦起重机;尽管在那些笔记中，他简化了事情，不处理从多个进程读取而没有锁定(在那些笔记中，临时文件用于第二个流)。

代码只使用Test::More并且没有非核心 Perl 模块

#!/usr/bin/perluse warnings;use strict;use POSIX qw(dup2);use Fcntl qw(:DEFAULT);use IO::Handle;use IO::Select;use IO::Pipe;use Test::More;# [...]# from http://aaroncrane.co.uk/talks/pipes_and_processes/sub fork_child (&) {    my ($child_process_code) = @_;    my $pid = fork();    die "Failed to fork: $!\n" if !defined $pid;    return $pid if $pid != 0;    # Now we're in the new child process    $child_process_code->();    exit;}sub parallel_run (&) {    my $child_code = shift;    my $nchildren = 2;    my %children;    my (%pid_for_child, %fd_for_child);    my $sel = IO::Select->new();    foreach my $child_idx (1..$nchildren) {        my $pipe = IO::Pipe->new()            or die "Failed to create pipe: $!\n";        my $pid = fork_child {            $pipe->writer()                or die "$$: Child \$pipe->writer(): $!\n";            dup2(fileno($pipe), fileno(STDOUT))                or die "$$: Child $child_idx failed to reopen stdout to pipe: $!\n";            close $pipe                or die "$$: Child $child_idx failed to close pipe: $!\n";            # From Test-Simple-0.96/t/subtest/fork.t            #            # Force all T::B output into the pipe (redirected to STDOUT),            # for the parent builder as well as the current subtest builder.            {                no warnings 'redefine';                *Test::Builder::output         = sub { *STDOUT };                *Test::Builder::failure_output = sub { *STDOUT };                *Test::Builder::todo_output    = sub { *STDOUT };            }            $child_code->();            *STDOUT->flush();            close(STDOUT);        };        $pid_for_child{$pid} = $child_idx;        $pipe->reader()            or die "Failed to \$pipe->reader(): $!\n";        $fd_for_child{$pipe} = $child_idx;        $sel->add($pipe);        $children{$child_idx} = {            'pid'    => $pid,            'stdout' => $pipe,            'output' => '',        };    }    while (my @ready = $sel->can_read()) {        foreach my $fh (@ready) {            my $buf = '';            my $nread = sysread($fh, $buf, 1024);            exists $fd_for_child{$fh}                or die "Cannot find child for fd: $fh\n";            if ($nread > 0) {                $children{$fd_for_child{$fh}}{'output'} .= $buf;            } else {                $sel->remove($fh);            }        }    }    while (%pid_for_child) {        my $pid = waitpid -1, 0;        warn "Child $pid_for_child{$pid} ($pid) failed with status: $?\n"            if $? != 0;        delete $pid_for_child{$pid};    }    return map { $children{$_}{'output'} } keys %children;}# [...]@output = parallel_run {    my $data = $cache->compute($key, \&get_value_slow);    print $data;};is_deeply(    \@output,    [ ($value) x 2 ],    'valid data returned by both process');