cas_test.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Test::More;
use Test::TCP qw/empty_port wait_port/;
use File::Which qw/which/;
use Proc::Guard;
use Parallel::ForkManager;
use Cache::Memcached::Fast;
use Time::HiRes qw/time sleep/;

my ($proc, $port) = memd();

my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
$memd->set('test', 0);

my $count = 0;

my $pm = new Parallel::ForkManager(30);
$pm->run_on_finish(sub{
	my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_;
	$count++ if ($data->{ret});
});

for (1..10) {
	$count = 0;
	my $time = time;
	for my $child (1..30) {
		$pm->start and next;
		my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
		my $ret = $memd->gets('test');
		my ($cas, $val) = @$ret;
		while (time - ($time + 1) < 0) {
			sleep 0.01;
		}
		my $_ret = $memd->cas('test', $cas, $$) ? 1 : 0;
		$pm->finish(0, { pid => $$, ret => $_ret });
	}
	$pm->wait_all_children;
	is $count, 1;
}

done_testing;

sub memd {
	my $port = empty_port();
	my $proc = proc_guard(scalar(which 'memcached'), '-p', $port);
	wait_port($port);
	return $proc, $port;
}

$ perl -MTest::Pretty cas_test.pl
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;
✓ L41: is $count, 1;