mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
111 lines
2.5 KiB
Perl
111 lines
2.5 KiB
Perl
# This is testing the transaction support.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use lib "t/lib";
|
|
use SQLiteTest;
|
|
use Test::More;
|
|
# use if -d ".git", "Test::FailWarnings";
|
|
|
|
my $warning_count = 0;
|
|
|
|
#####################################################################
|
|
# Support functions
|
|
|
|
sub insert {
|
|
Test::More::ok(
|
|
$_[0]->do("INSERT INTO one VALUES (1, 'Jochen')"),
|
|
'INSERT 1',
|
|
);
|
|
}
|
|
|
|
sub rows {
|
|
my $dbh = shift;
|
|
my $expected = shift;
|
|
is_deeply(
|
|
$dbh->selectall_arrayref('select count(*) from one'),
|
|
[ [ $expected ] ],
|
|
"Found $expected rows",
|
|
);
|
|
}
|
|
|
|
#####################################################################
|
|
# Main Tests
|
|
|
|
# Create a database
|
|
my $dbh = connect_ok( dbfile => 'foo', RaiseError => 1 );
|
|
|
|
# Create the table
|
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
|
CREATE TABLE one (
|
|
id INTEGER NOT NULL,
|
|
name CHAR (64) NOT NULL
|
|
)
|
|
END_SQL
|
|
|
|
# Turn AutoCommit off
|
|
$dbh->{AutoCommit} = 0;
|
|
ok( ! $dbh->{AutoCommit}, 'AutoCommit is off' );
|
|
ok( ! $dbh->err, '->err is false' );
|
|
ok( ! $dbh->errstr, '->err is false' );
|
|
|
|
# Check rollback
|
|
insert( $dbh );
|
|
rows( $dbh, 1 );
|
|
ok( $dbh->rollback, '->rollback ok' );
|
|
rows( $dbh, 0 );
|
|
|
|
# Check commit
|
|
ok( $dbh->do('DELETE FROM one WHERE id = 1'), 'DELETE 1' );
|
|
rows( $dbh, 0 );
|
|
ok( $dbh->commit, '->commit ok' );
|
|
rows( $dbh, 0 );
|
|
|
|
# Check auto rollback after disconnect
|
|
insert( $dbh );
|
|
rows( $dbh, 1 );
|
|
ok( $dbh->disconnect, '->disconnect ok' );
|
|
$dbh = connect_ok( dbfile => 'foo' );
|
|
rows( $dbh, 0 );
|
|
|
|
# Check that AutoCommit is back on again after the reconnect
|
|
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on' );
|
|
|
|
# Check whether AutoCommit mode works.
|
|
insert( $dbh );
|
|
rows( $dbh, 1 );
|
|
ok( $dbh->disconnect, '->disconnect ok' );
|
|
$dbh = connect_ok( dbfile => 'foo' );
|
|
rows( $dbh, 1 );
|
|
|
|
# Check whether commit issues a warning in AutoCommit mode
|
|
ok( $dbh->do("INSERT INTO one VALUES ( 2, 'Tim' )"), 'INSERT 2' );
|
|
SCOPE: {
|
|
local $@ = '';
|
|
$SIG{__WARN__} = sub {
|
|
$warning_count++;
|
|
};
|
|
eval {
|
|
$dbh->commit;
|
|
};
|
|
$SIG{__WARN__} = 'DEFAULT';
|
|
is( $warning_count, 1, 'Got one warning' );
|
|
}
|
|
|
|
# Check whether rollback issues a warning in AutoCommit mode
|
|
# We accept error messages as being legal, because the DBI
|
|
# requirement of just issueing a warning seems scary.
|
|
ok( $dbh->do("INSERT INTO one VALUES ( 3, 'Alligator' )"), 'INSERT 3' );
|
|
SCOPE: {
|
|
local $@ = '';
|
|
$SIG{__WARN__} = sub {
|
|
$warning_count++;
|
|
};
|
|
eval {
|
|
$dbh->rollback;
|
|
};
|
|
$SIG{__WARN__} = 'DEFAULT';
|
|
is( $warning_count, 2, 'Got one warning' );
|
|
}
|
|
|
|
done_testing;
|