Question

How can I test that resource (file based cache for caching output of a webapp in Perl) behaves sanely under concurrent access to said shared resource?

I wrote a simple file-based cache, written in Perl, which uses locking to serialize write access, i.e. to have only one process that (re)generates cache entry. This cache is to be used for caching output of Perl webapp (gitweb), if it matters.

I’d like to test that said cache behaves sanely under concurrent access, for example that only one process would run subroutine used to generate cache ($cache->compute($key, sub { ... })), that all processes would get generated data, that if process writing to cache entry dies it wouldn’t deadlock processes waiting for cache to be (re)generated etc.

How should I do it? Is there a ready Perl module that I can use?

Answer 1

In the end I based my work on Unix for Perl programmers: pipes and processes by Aaron Crane; though in those notes he simplified things to not deal with reading from multiple processes without locking (in those notes temporary file is used for second stream).

The code uses only Test::More and no non-core Perl modules

#!/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'
);