How to test concurrent access to resource (cache) in Perl?

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 开发者_如何学Gogenerated 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?

---

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

---

Have two processes:

• Write out the time before access.
• Attempt access
• Sleep for 5 seconds with the lock
• Release the lock and write the time.

It should take one process twice the time of the other one.

As for testing whether or not it cleans up when a process dies. die with the lock instead. Or if this is pretty black box, start a thread that calls exit when you expect the process to have the lock.

But, I'm not sure how you cause the whole process to sleep from a single thread.

---

I would use Test::Class and Test::Exception as the infrastructure for creating the tests.

...for example that only one process would run subroutine used to generate cache ($cache->compute($key, sub { ... }))

Should probably become something like this:

sub test_inter_process_mutex {
  # spawn process to acquire a lock, capture the pid
  # assert I except when trying to acquire the lock
  # send HUP signal to process, process releases lock and dies
}

that all processes would get generated data

This ones harder. I would probably try and isolate the communication mechanism and assert that it works a certain way.

that if process writing to cache entry dies it wouldn't deadlock processes waiting for cache to be (re)generated etc.

becomes:

sub test_no_process_deathgrip {
  # spawn process to acquire the lock and then except
  # assert I can acquire the lock

  # for signals HUP, SIGINT, TERM, and KILL
  # spawn a process to acquire the lock, capture pid
  # send signal to process
  # assert I can acquire the lock
}

}