#!/usr/bin/perl
# Test that two processes can write at once, assuming we commit timely.
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok dbfile @CALL_FUNCS/;
use Test::More;
use Test::NoWarnings;
plan tests => 11 * @CALL_FUNCS + 1;
foreach my $call_func (@CALL_FUNCS) {
my $dbh = connect_ok(
dbfile => 'foo',
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
);
my $dbh2 = connect_ok(
dbfile => 'foo',
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
);
my $dbfile = dbfile('foo');
# NOTE: Let's make it clear what we're doing here.
# $dbh starts locking with the first INSERT statement.
# $dbh2 tries to INSERT, but as the database is locked,
# it starts waiting. However, $dbh won't release the lock.
# Eventually $dbh2 gets timed out, and spits an error, saying
# the database is locked. So, we don't need to let $dbh2 wait
# too much here. It should be timed out anyway.
ok($dbh2->$call_func(300, 'busy_timeout'));
ok($dbh->do("CREATE TABLE Blah ( id INTEGER, val VARCHAR )"));
ok($dbh->commit);
ok($dbh->do("INSERT INTO Blah VALUES ( 1, 'Test1' )"));
eval {
$dbh2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )");
};
ok($@);
if ($@) {
print "# expected insert failure : $@";
$dbh2->rollback;
}
$dbh->commit;
ok($dbh2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )"));
$dbh2->commit;
$dbh2->disconnect;
undef($dbh2);
# NOTE: The second test is to see what happens if a lock is
# is released while waiting. When both parent and child are
# ready, the database is locked by the child. The parent
# starts waiting for a long enough time (apparently we need
# to wait much longer than we expected, as testers may use
# very slow (virtual) machines to test, but don't worry,
# it's only for the slowest environment). After a short sleep,
# the child commits and releases the lock. Eventually the parent
# notices that, and does the pended INSERT (hopefully before
# it is timed out). As both the parent and the child wait till
# both are ready, we don't need to sleep for a long time.
pipe(READER, WRITER);
my $pid = fork;
if (!defined($pid)) {
# fork failed
SKIP: {
skip("No fork here", 3);
}
$dbh->disconnect;
unlink $dbfile;
} elsif (!$pid) {
# child
# avoid resource collisions after fork
# http://www.slideshare.net/kazuho/un-5457977
unless ($^O eq 'MSWin32') { # ignore fork emulation
$dbh->{InactiveDestroy} = 1;
undef $dbh;
}
my $dbh2 = DBI->connect("dbi:SQLite:$dbfile", '', '',
{
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
});
$dbh2->do("INSERT INTO Blah VALUES ( 3, 'Test3' )");
select WRITER; $| = 1; select STDOUT;
print WRITER "Ready\n";
sleep(2);
$dbh2->commit;
$dbh2->disconnect;
exit;
} else {
# parent
close WRITER;
my $line = <READER>;
chomp($line);
ok($line, "Ready");
ok($dbh->$call_func(100000, 'busy_timeout'));
eval { $dbh->do("INSERT INTO Blah VALUES (4, 'Test4' )") };
ok !$@;
if ($@) {
print STDERR "# Your testing environment might be too slow to pass this test: $@";
$dbh->rollback;
}
else {
$dbh->commit;
}
wait;
$dbh->disconnect;
unlink $dbfile;
}
}