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/perl

use 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'
);