simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 06:08:38 -04:00
Code Issues Releases Wiki Activity

Refactoring away needless test complexity

Browse source
This commit is contained in:
Adam Kennedy 2009-04-03 17:07:49 +00:00
parent d5302acfba
commit 3f0f9ca82c
31 changed files with 325 additions and 755 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -4,6 +4,5 @@ blib/
SQLite.c
*.xsi
pm_to_blib
output/
Makefile
Makefile.old

2
Changes
View file

@ -15,6 +15,8 @@ Revision history for Perl extension DBD-SQLite.
version-dependency conditional (ADAMK)
- All tests run under the same Perl environment
(autoflush on, and warnings enabled via $^W = 1) (ADAMK)
- Refactored away a ton of needless complexity from the
older-style tests inherited from the CSV driver (ADAMK)
1.19_05 Thu 2 Apr 2009
- DBD::SQLite::Amalgamation 3.6.1.2 and DBD::SQLite 1.19

2
MANIFEST.SKIP
View file

@ -7,11 +7,9 @@ CVS/.*
\.o$
\.xsi$
\.bs$
output/.*
^.#
^mess/
^sqlite/
^output/
^tmp/
^blib/
^Makefile$

2
Makefile.PL
View file

@ -215,7 +215,7 @@ WriteMakefile(
OBJECT => ( $force_local ? '$(O_FILES)' : 'SQLite.o dbdimp.o' ),
OPTIMIZE => '-O2',
clean => {
FILES => 'SQLite.xsi config.h tv.log output',
FILES => 'SQLite.xsi config.h tv.log',
},
PL_FILES => {},
EXE_FILES => [],

5
t/01logon.t
View file

@ -8,11 +8,12 @@ BEGIN {
$^W = 1;
}
use Test::More tests => 5;
use Test::More tests => 6;
use t::lib::Test;
my $dbh = sqlite_connect();
my $dbh = connect_ok();
ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' );
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
diag("sqlite_version=$dbh->{sqlite_version}");
ok( $dbh->func('busy_timeout'), 'Found initial busy_timeout' );
ok( $dbh->func(5000, 'busy_timeout') );

3
t/02create_table.t
View file

@ -11,8 +11,7 @@ BEGIN {
use Test::More tests => 5;
use t::lib::Test;
my $dbh = sqlite_connect();
$dbh->{AutoCommit} = 1;
my $dbh = connect_ok();
$dbh->do("CREATE TABLE f (f1, f2, f3)");
SCOPE: {

33
t/03insert.t
View file

@ -9,25 +9,28 @@ BEGIN {
use Test::More tests => 11;
use t::lib::Test;
my $dbh = sqlite_connect( AutoCommit => 1 );
my $dbh = connect_ok();
$dbh->do("CREATE TABLE f (f1, f2, f3)");
ok($dbh->do("delete from f"));
my $sth = $dbh->prepare("INSERT INTO f VALUES (?, ?, ?)", { go_last_insert_id_args => [undef, undef, undef, undef] });
ok($sth);
ok(my $rows = $sth->execute("Fred", "Bloggs", "fred\@bloggs.com"));
ok($rows == 1);
ok( $dbh->do("CREATE TABLE f (f1, f2, f3)"), 'CREATE TABLE f' );
ok( $dbh->do("delete from f"), 'DELETE FROM f' );
is($sth->execute("test", "test", "1"), 1);
is($sth->execute("test", "test", "2"), 1);
is($sth->execute("test", "test", "3"), 1);
SCOPE: {
my $sth = $dbh->prepare("INSERT INTO f VALUES (?, ?, ?)", { go_last_insert_id_args => [undef, undef, undef, undef] });
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute("Fred", "Bloggs", "fred\@bloggs.com");
is( $rows, 1, '->execute returns 1 row' );
SKIP: {
skip( 'last_insert_id requires DBI v1.43', 2 ) if $DBI::VERSION < 1.43;
is( $dbh->last_insert_id(undef, undef, undef, undef), 4 );
is( $dbh->func('last_insert_rowid'), 4, 'last_insert_rowid should be 4' );
is( $sth->execute("test", "test", "1"), 1 );
is( $sth->execute("test", "test", "2"), 1 );
is( $sth->execute("test", "test", "3"), 1 );
SKIP: {
skip( 'last_insert_id requires DBI v1.43', 2 ) if $DBI::VERSION < 1.43;
is( $dbh->last_insert_id(undef, undef, undef, undef), 4 );
is( $dbh->func('last_insert_rowid'), 4, 'last_insert_rowid should be 4' );
}
}
is( $dbh->do("delete from f where f1='test'"), 3 );
$sth->finish;
$dbh->disconnect;

5
t/04select.t
View file

@ -9,20 +9,17 @@ BEGIN {
use Test::More tests => 21;
use t::lib::Test;
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1, AutoCommit => 1 });
ok($dbh);
my $dbh = connect_ok( RaiseError => 1 );
$dbh->do("CREATE TABLE f (f1, f2, f3)");
my $sth = $dbh->prepare("INSERT INTO f VALUES (?, ?, ?)", { go_last_insert_id_args => [undef, undef, undef, undef] });
$sth->execute("Fred", "Bloggs", "fred\@bloggs.com");
# $dbh->trace(4);
$sth = $dbh->prepare("SELECT * FROM f");
ok($sth);
ok($sth->execute);
my $row = $sth->fetch;
ok($row);
is(@$row, 3);
print join(", ", @$row), "\n";
my $rows = $sth->execute;
ok($rows);
ok($sth->fetch);

9
t/05tran.t
View file

@ -9,11 +9,10 @@ BEGIN {
use Test::More tests => 2;
use t::lib::Test;
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "",
{AutoCommit => 0, RaiseError => 1});
# $dbh->trace(2);
ok($dbh);
my $dbh = connect_ok(
AutoCommit => 0,
RaiseError => 1,
);
$dbh->do("CREATE TABLE MST (id, lbl)");
$dbh->do("CREATE TABLE TRN (no, id, qty)");

16
t/06error.t
View file

@ -6,21 +6,21 @@ BEGIN {
$^W = 1;
}
use Test::More tests => 2;
use Test::More tests => 3;
use t::lib::Test;
my $db = DBI->connect('dbi:SQLite:foo', '', '', { RaiseError => 1, PrintError => 0 });
my $dbh = connect_ok( RaiseError => 1, PrintError => 0 );
eval {
$db->do('ssdfsdf sdf sd sdfsdfdsf sdfsdf');
$dbh->do('ssdfsdf sdf sd sdfsdfdsf sdfsdf');
};
ok($@);
$db->do('create table testerror (a, b)');
$db->do('insert into testerror values (1, 2)');
$db->do('insert into testerror values (3, 4)');
$dbh->do('create table testerror (a, b)');
$dbh->do('insert into testerror values (1, 2)');
$dbh->do('insert into testerror values (3, 4)');
$db->do('create unique index testerror_idx on testerror (a)');
$dbh->do('create unique index testerror_idx on testerror (a)');
eval {
$db->do('insert into testerror values (1, 5)');
$dbh->do('insert into testerror values (1, 5)');
};
ok($@);

50
t/07busy.t
View file

@ -1,51 +1,49 @@
#!/usr/bin/perl
# Test that two processes can write at once, assuming we commit timely.
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More tests => 8;
use Test::More tests => 10;
use t::lib::Test;
my $db = DBI->connect('dbi:SQLite:foo', '', '',
{
my $dbh = connect_ok(
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
});
);
my $db2 = DBI->connect('dbi:SQLite:foo', '', '',
{
my $dbh2 = connect_ok(
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
});
);
ok($db2->func(3000, 'busy_timeout'));
ok($dbh2->func(3000, 'busy_timeout'));
ok($db->do("CREATE TABLE Blah ( id INTEGER, val VARCHAR )"));
ok($db->commit);
ok($db->do("INSERT INTO Blah VALUES ( 1, 'Test1' )"));
ok($dbh->do("CREATE TABLE Blah ( id INTEGER, val VARCHAR )"));
ok($dbh->commit);
ok($dbh->do("INSERT INTO Blah VALUES ( 1, 'Test1' )"));
my $start = time;
eval {
$db2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )");
$dbh2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )");
};
ok($@);
if ($@) {
print "# insert failed : $@";
$db2->rollback;
$dbh2->rollback;
}
$db->commit;
ok($db2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )"));
$db2->commit;
$dbh->commit;
ok($dbh2->do("INSERT INTO Blah VALUES ( 2, 'Test2' )"));
$dbh2->commit;
$db2->disconnect;
undef($db2);
# Now test that two processes can write at once, assuming we commit timely.
$dbh2->disconnect;
undef($dbh2);
pipe(READER, WRITER);
my $pid = fork;
@ -55,25 +53,25 @@ if (!defined($pid)) {
skip("No fork here", 1);
} elsif (!$pid) {
# child
my $db2 = DBI->connect('dbi:SQLite:foo', '', '',
my $dbh2 = DBI->connect('dbi:SQLite:foo', '', '',
{
RaiseError => 1,
PrintError => 0,
AutoCommit => 0,
});
$db2->do("INSERT INTO Blah VALUES ( 3, 'Test3' )");
$dbh2->do("INSERT INTO Blah VALUES ( 3, 'Test3' )");
select WRITER; $| = 1; select STDOUT;
print WRITER "Ready\n";
sleep(5);
$db2->commit;
$dbh2->commit;
} else {
# parent
close WRITER;
my $line = <READER>;
chomp($line);
ok($line, "Ready");
$db->func(10000, 'busy_timeout');
ok($db->do("INSERT INTO Blah VALUES (4, 'Test4' )"));
$db->commit;
$dbh->func(10000, 'busy_timeout');
ok($dbh->do("INSERT INTO Blah VALUES (4, 'Test4' )"));
$dbh->commit;
wait;
}

15
t/08create_function.t
View file

@ -50,8 +50,7 @@ sub noop {
return $_[0];
}
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { PrintError => 0 } );
isa_ok( $dbh, 'DBI::db' );
my $dbh = connect_ok( PrintError => 0 );
$dbh->func( "now", 0, \&now, "create_function" );
my $result = $dbh->selectrow_arrayref( "SELECT now()" );
@ -73,14 +72,10 @@ $dbh->func( "my_sum", -1, \&my_sum, "create_function" );
$result = $dbh->selectrow_arrayref( "SELECT my_sum( '2', 3, 4, '5')" );
is( $result->[0], 14, "SELECT my_sum( '2', 3, 4, '5')" );
SKIP: {
# skip "this test is currently broken on some platforms; set DBD_SQLITE_TODO=1 to test this", 2 unless $ENV{DBD_SQLITE_TODO};
$dbh->func( "error", -1, \&error, "create_function" );
$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
ok( !$result );
like( $DBI::errstr, qr/function is dying: I died/ );
}
$dbh->func( "error", -1, \&error, "create_function" );
$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
ok( !$result );
like( $DBI::errstr, qr/function is dying: I died/ );
$dbh->func( "void_return", -1, \&void_return, "create_function" );
$result = $dbh->selectrow_arrayref( "SELECT void_return( 'I died' )" );

4
t/09create_aggregate.t
View file

@ -67,10 +67,8 @@ SCOPE: {
}
}
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { PrintError => 0 } );
ok($dbh);
my $dbh = connect_ok( PrintError => 0 );
$dbh->do( "DROP TABLE aggr_test;" );
$dbh->do( "CREATE TABLE aggr_test ( field )" );
foreach my $val ( qw/NULL 1 'test'/ ) {
$dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );

28
t/11unicode.t
View file

@ -9,18 +9,19 @@ BEGIN {
$^W = 1;
}
use t::lib::Test;
#
# Include std stuff
#
use Carp;
use DBI qw(:sql_types);
our ($mdriver, $test_dsn, $test_user, $test_password, $file);
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
last if ($mdriver);
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
BEGIN {if ($] < 5.006) {
@ -64,10 +65,10 @@ Test(! is_utf8($bytestring),
### Real DBD::SQLite testing starts here
my $dbh = DBI->connect($test_dsn, $test_user, $test_password,
my $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '',
{RaiseError => 1})
or die <<'MESSAGE';
Cannot connect to database $test_dsn, please check directory and
Cannot connect to database 'DBI:SQLite:dbname=foo', please check directory and
permissions.
MESSAGE
@ -106,12 +107,12 @@ Test($textback eq $bytestring, "Same text, different encoding");
# Start over but now activate Unicode support.
if ($ENV{DBI_AUTOPROXY}) {
if ( $ENV{DBI_AUTOPROXY} ) {
# for testing DBD::Gofer we have to create a new dbh with unicode enabled
# because we can't change the attribute for an existing dbh
$dbh = DBI->connect($test_dsn, $test_user, $test_password, {
$dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '', {
RaiseError => 1,
unicode => 1,
unicode => 1,
})
}
else {
@ -133,4 +134,7 @@ Test($lengths->[0]->[0] == $lengths->[0]->[1],
"Database actually understands char set") or
warn "($lengths->[0]->[0] != $lengths->[0]->[1])";
END { $dbh->do("DROP TABLE $table"); $dbh->disconnect; unlink 'output/foo'; rmdir 'output'; }
END {
$dbh->do("DROP TABLE $table");
$dbh->disconnect;
}

53
t/12create_collation.t
View file

@ -6,20 +6,21 @@ BEGIN {
$^W = 1;
}
BEGIN {
local $@;
unless (eval { require Test::More; require Encode; 1 }) {
print "1..0 # Skip need Perl 5.8 or later\n";
exit;
}
use Test::More;
BEGIN {
if ( $] >= 5.008 ) {
plan( tests => 8 );
} else {
plan( skip_all => 'Need Perl 5.8 or later' );
exit(0);
}
}
use Test::More tests => 8;
use t::lib::Test;
use Encode qw/decode/;
BEGIN {
# sadly perl for windows (and probably sqlite, too) may hang
# Sadly perl for windows (and probably sqlite, too) may hang
# if the system locale doesn't support european languages.
# en-us should be a safe default. if it doesn't work, use 'C'.
if ($^O eq 'MSWin32') {
@ -28,17 +29,17 @@ BEGIN {
}
}
my @words = qw/berger Bergère bergère Bergere
HOT hôte
hétéroclite hétaïre hêtre héraut
HAT hâter
fétu fête fève ferme/;
my @words = qw{
berger Bergère bergère Bergere
HOT hôte
hétéroclite hétaïre hêtre héraut
HAT hâter
fétu fête fève ferme
};
# my @words_utf8 = map {decode("iso-8859-1", $_)} @words;
my @words_utf8 = @words;
utf8::upgrade($_) foreach @words_utf8;
$" = ", "; # to embed arrays into message strings
my $dbh;
@ -55,22 +56,21 @@ sub no_accents ($$) {
$a cmp $b;
}
$dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 } );
ok($dbh);
$dbh = connect_ok( RaiseError => 1 );
$dbh->func( "no_accents", \&no_accents, "create_collation" );
$dbh->do( 'CREATE TEMP TABLE collate_test ( txt )' );
$dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words;
@sorted = sort @words;
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perl");
is_deeply(\@sorted, $db_sorted, "collate perl (@sorted // @$db_sorted)");
{use locale; @sorted = sort @words;}
SCOPE: {
use locale;
@sorted = sort @words;
}
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perllocale");
is_deeply(\@sorted, $db_sorted, "collate perllocale (@sorted // @$db_sorted)");
@ -79,11 +79,7 @@ $db_sorted = $dbh->selectcol_arrayref("$sql COLLATE no_accents");
is_deeply(\@sorted, $db_sorted, "collate no_accents (@sorted // @$db_sorted)");
$dbh->disconnect;
$dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "",
{ RaiseError => 1,
unicode => 1} );
ok($dbh);
$dbh = connect_ok( RaiseError => 1, unicode => 1 );
$dbh->func( "no_accents", \&no_accents, "create_collation" );
$dbh->do( 'CREATE TEMP TABLE collate_test ( txt )' );
$dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words_utf8;
@ -92,7 +88,10 @@ $dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words_utf8;
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perl");
is_deeply(\@sorted, $db_sorted, "collate perl (@sorted // @$db_sorted)");
{use locale; @sorted = sort @words_utf8;}
SCOPE: {
use locale;
@sorted = sort @words_utf8;
}
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perllocale");
is_deeply(\@sorted, $db_sorted, "collate perllocale (@sorted // @$db_sorted)");

3
t/13progress_handler.t
View file

@ -19,8 +19,7 @@ sub progress_handler {
}
# connect and register the progress handler
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 } );
ok($dbh);
my $dbh = connect_ok( RaiseError => 1 );
$dbh->func( $N_OPCODES, \&progress_handler, "progress_handler" );
# populate a temporary table with random numbers

143
t/14ak_dbd.t
View file

@ -6,44 +6,18 @@ BEGIN {
$^W = 1;
}
use t::lib::Test;
#
# Make -w happy
#
use vars qw($test_dsn $test_user $test_password $dbdriver $mdriver
$verbose $state);
use vars qw($state);
use vars qw($COL_NULLABLE $COL_KEY);
$test_dsn = '';
$test_user = '';
$test_password = '';
#
# Include lib.pl
#
use DBI;
use strict;
$dbdriver = "";
{ my $file;
foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($dbdriver ne '') {
last;
}
}
}
my $test_db = '';
my $test_hostname = $ENV{DBI_HOST} || 'localhost';
if ($test_dsn =~ /^DBI\:[^\:]+\:/) {
$test_db = $';
if ($test_db =~ /:/) {
$test_db = $`;
$test_hostname = $';
}
}
require "t/lib.pl";
#
# Main loop; leave this untouched, put tests after creating
@ -54,33 +28,13 @@ while (Testing()) {
# Connect to the database
my($dbh, $sth, $test_table, $query);
$test_table = ''; # Avoid warnings for undefined variables.
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '')))
or ErrMsg("Cannot connect: $DBI::errstr.\n");
#
# Verify whether constants work
#
if ($mdriver eq 'mysql') {
my ($val);
Test($state or (($val = &DBD::mysql::FIELD_TYPE_STRING()) == 254))
or ErrMsg("Wrong value for FIELD_TYPE_STRING:"
. " Expected 254, got $val\n");
Test($state or (($val = &DBD::mysql::FIELD_TYPE_SHORT()) == 2))
or ErrMsg("Wrong value for FIELD_TYPE_SHORT:"
. " Expected 2, got $val\n");
} elsif ($mdriver eq 'mSQL') {
my ($val);
Test($state or (($val = &DBD::mSQL::CHAR_TYPE()) == 2))
or ErrMsg("Wrong value for CHAR_TYPE: Expected 2, got $val\n");
Test($state or (($val = &DBD::mSQL::INT_TYPE()) == 1))
or ErrMsg("Wrong value for INT_TYPE: Expected 1, got $val\n");
}
#
# Find a possible new table name
#
Test($state or $test_table = FindNewTable($dbh)) or !$verbose
Test($state or $test_table = FindNewTable($dbh)) or 1
or ErrMsg("Cannot get table name: $dbh->errstr.\n");
#
@ -107,24 +61,9 @@ while (Testing()) {
"case of the server running on a remote machine.\n");
### Now, re-connect again so that we can do some more complicated stuff..
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '')))
or ErrMsg("reconnect failed: $DBI::errstr\n");
### List all the tables in the selected database........
### This test for mSQL and mysql only.
if ($mdriver eq 'mysql' or $mdriver eq 'mSQL' or $mdriver eq 'mSQL1') {
Test($state or $dbh->func('_ListTables'))
or ErrMsgF("_ListTables failed: $dbh->errstr.\n"
. "This could be due to the fact you have no tables,"
. " but I hope not. You\n"
. "could try running '%s -h %s %s' and see if it\n"
. "reports any information about your database,"
. " or errors.\n",
($mdriver eq 'mysql') ? "mysqlshow" : "relshow",
$test_hostname, $test_db);
}
Test($state or $dbh->do("DROP TABLE $test_table"))
or ErrMsg("Dropping table failed: $dbh->errstr.\n");
Test($state or ($query = TableDefinition($test_table,
@ -133,14 +72,6 @@ while (Testing()) {
$dbh->do($query)))
or ErrMsg("create failed, query $query, error $dbh->errstr.\n");
### Get some meta-data for the table we've just created...
if ($mdriver eq 'mysql' or $mdriver eq 'mSQL1' or $mdriver eq 'mSQL') {
my $ref;
Test($state or ($ref = $dbh->prepare("LISTFIELDS $test_table")))
or ErrMsg("listfields failed: $dbh->errstr.\n");
Test($state or $ref->execute);
}
### Insert a row into the test table.......
print "Inserting a row...\n";
Test($state or ($dbh->do("INSERT INTO $test_table VALUES(1,"
@ -191,11 +122,6 @@ while (Testing()) {
Test($state or ($sth = $dbh->prepare($query = "SELECT * FROM $test_table"
. " WHERE id = 1")))
or ErrMsgF("prepare failed: query $query, error %s.\n", $dbh->errstr);
if ($dbdriver eq 'mysql' || $dbdriver eq 'mSQL' ||
$dbdriver eq 'mSQL1') {
Test($state or defined($sth->rows))
or ErrMsg("sth->rows returning result before 'execute'.\n");
}
if (!$state) {
print "Test 19: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
@ -214,7 +140,7 @@ while (Testing()) {
$query = "INSERT INTO $test_table VALUES ( NULL, 'NULL-valued id' )";
Test($state or $dbh->do($query))
or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
$query = "SELECT id FROM $test_table WHERE " . IsNull("id");
$query = "SELECT id FROM $test_table WHERE id IS NULL";
Test($state or ($sth = $dbh->prepare($query)))
or ErrMsgF("Cannot prepare, query = $query, error %s.\n",
$dbh->errstr);
@ -225,9 +151,6 @@ while (Testing()) {
or ErrMsgF("Cannot execute, query = $query, error %s.\n",
$dbh->errstr);
my $rv;
Test($state or defined($rv = $sth->fetch) or $dbdriver eq 'CSV'
or $dbdriver eq 'ConfFile')
or ErrMsgF("fetch failed, error %s.\n", $dbh->errstr);
Test($state or !defined($$rv[0]))
or ErrMsgF("Expected NULL value, got %s.\n", $$rv[0]);
Test($state or $sth->finish)
@ -272,15 +195,6 @@ while (Testing()) {
or ErrMsg("prepare failed: query $query, error $dbh->errstr.\n");
Test($state or $sth->execute)
or ErrMsg("execute failed: query $query, error $dbh->errstr.\n");
if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' || $mdriver eq 'mSQL1') {
my($warning);
$SIG{__WARN__} = sub { $warning = shift; };
Test($state or ($ref = $sth->func('_ListSelectedFields')))
or ErrMsg("_ListSelectedFields failed, error $sth->errstr.\n");
Test($state or ($warning =~ /deprecated/))
or ErrMsg("Expected warning from _ListSelectedFields");
$SIG{__WARN__} = 'DEFAULT';
}
Test($state or $sth->execute, 'execute 284')
or ErrMsg("re-execute failed: query $query, error $dbh->errstr.\n");
Test($state or (@row = $sth->fetchrow_array), 'fetchrow 286')
@ -298,11 +212,6 @@ while (Testing()) {
Test($state or ($sth = $dbh->prepare($query)))
or ErrMsg("prepare failed: query $query, error $sth->errmsg.\n");
# This should fail: We "forgot" execute.
if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' ||
$mdriver eq 'mSQL1') {
Test($state or !defined($sth->{'NAME'}))
or ErrMsg("Expected error without execute, got $ref.\n");
}
Test($state or undef $sth or 1);
### Drop the test table out of our database to clean up.........
@ -313,40 +222,4 @@ while (Testing()) {
Test($state or $dbh->disconnect)
or ErrMsg("disconnect failed: $dbh->errstr.\n");
#
# Try mysql's insertid feature
#
if ($dbdriver eq 'mysql') {
my ($sth, $table);
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
or ErrMsgF("connect failed: %s.\n", $DBI::errstr);
Test($state or ($table = FindNewTable($dbh)));
Test($state or $dbh->do("CREATE TABLE $table ("
. " id integer AUTO_INCREMENT PRIMARY KEY,"
. " country char(30) NOT NULL)"))
or printf("Error while executing query: %s\n", $dbh->errstr);
Test($state or
($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'a')")))
or printf("Error while preparing query: %s\n", $dbh->errstr);
Test($state or $sth->execute)
or printf("Error while executing query: %s\n", $sth->errstr);
Test($state or $sth->finish)
or printf("Error while finishing query: %s\n", $sth->errstr);
Test($state or
($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'b')")))
or printf("Error while preparing query: %s\n", $dbh->errstr);
Test($state or $sth->execute)
or printf("Error while executing query: %s\n", $sth->errstr);
Test($state or $sth->{insertid} =~ /\d+/)
or printf("insertid generated incorrect result: %s\n",
$sth->insertid);
Test($state or $sth->finish)
or printf("Error while finishing query: %s\n", $sth->errstr);
Test($state or $dbh->do("DROP TABLE $table"));
Test($state or $dbh->disconnect)
or ErrMsg("disconnect failed: $dbh->errstr.\n");
}
}
END { unlink 'output/foo'; rmdir 'output' }

24
t/20createdrop.t
View file

@ -9,29 +9,21 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver);
$DBI::errstr = ''; # Make -w happy
require DBI;
use t::lib::Test;
#
# Include lib.pl
#
$mdriver = "";
my $file;
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -46,7 +38,7 @@ while (Testing()) {
#
# Connect to the database
my $dbh;
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
or ServerError();
#
@ -82,5 +74,3 @@ while (Testing()) {
Test($state or $dbh->disconnect())
or DbiError($dbh->err, $dbh->errstr);
}
END { unlink 'output/foo'; rmdir 'output' }

29
t/30insertfetch.t
View file

@ -8,34 +8,23 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $state);
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use t::lib::Test;
use vars qw($state);
#
# Include lib.pl
#
use DBI;
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -51,7 +40,7 @@ while (Testing()) {
#
# Connect to the database
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
'connect')
or ServerError();
@ -148,5 +137,3 @@ while (Testing()) {
or DbiError($dbh->err, $dbh->errstr);
}
END { unlink 'output/foo'; rmdir 'output' }

34
t/40bindparam.t
View file

@ -6,40 +6,25 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $state);
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use t::lib::Test;
use vars qw($state);
#
# Include lib.pl
#
require DBI;
use vars qw($COL_NULLABLE);
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'pNET') {
print "1..0\n";
exit 0;
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
my $err = $DBI::errstr; # Hate -w ...
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -61,7 +46,7 @@ my ($dbh, $def, $table, $cursor, $id, $name, $ref);
while (Testing()) {
#
# Connect to the database
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
'connect')
or ServerError();
@ -145,7 +130,7 @@ while (Testing()) {
#
# Connect to the database
#
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
'connect for read')
or ServerError();
@ -197,4 +182,3 @@ while (Testing()) {
or DbiError($dbh->err, $dbh->errstr);
}
END { unlink 'output/foo'; rmdir 'output' }

38
t/40blobs.t
View file

@ -9,14 +9,9 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver $state);
use t::lib::Test;
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use vars qw($state);
#
@ -25,25 +20,17 @@ $test_password = '';
use DBI qw(:sql_types);
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
if ($dbdriver eq 'mSQL' || $dbdriver eq 'mSQL1') {
print "1..0\n";
exit 0;
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
my $err = $DBI::errstr; # Hate -w ...
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -80,7 +67,7 @@ my ($dbh, $table, $cursor, $row);
while (Testing()) {
#
# Connect to the database
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
or ServerError();
@ -119,12 +106,7 @@ while (Testing()) {
for (my $i = 0; $i < $size; $i++) {
$blob .= $b;
}
if ($mdriver eq 'pNET') {
# Quote manually, no remote quote
$qblob = eval "DBD::" . $dbdriver . "::db->quote(\$blob)";
} else {
$qblob = $dbh->quote($blob);
}
$qblob = $dbh->quote($blob);
}
#
@ -175,5 +157,3 @@ while (Testing()) {
or DbiError($dbh->err, $dbh->errstr);
}
}
END { unlink 'output/foo'; rmdir 'output' }

57
t/40listfields.t
View file

@ -8,31 +8,20 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver $state $COL_KEY $COL_NULLABLE);
use t::lib::Test;
use vars qw($state $COL_KEY $COL_NULLABLE);
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
$COL_KEY = '';
#
# Include lib.pl
#
use DBI;
use vars qw($verbose);
$dbdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($dbdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
@ -44,7 +33,7 @@ my @table_def = (
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -59,7 +48,7 @@ my ($dbh, $table, $def, $cursor, $ref);
while (Testing()) {
#
# Connect to the database
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
or ServerError();
#
@ -85,33 +74,11 @@ while (Testing()) {
my $res;
Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
printf("Number of fields: %s\n", defined($res) ? $res : "undef");
}
Test($state or ($ref = $cursor->{'NAME'}) && @$ref == @table_def
&& (lc $$ref[0]) eq $table_def[0][0]
&& (lc $$ref[1]) eq $table_def[1][0])
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
print "Names:\n";
for (my $i = 0; $i < @$ref; $i++) {
print " ", $$ref[$i], "\n";
}
}
Test($state or ($dbdriver eq 'CSV') or ($dbdriver eq 'ConfFile')
or ($dbdriver eq 'SQLite')
or ($ref = $cursor->{'NULLABLE'}) && @$ref == @table_def
&& !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
&& !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
print "Nullable:\n";
for (my $i = 0; $i < @$ref; $i++) {
print " ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
}
}
Test($state or undef $cursor || 1);
@ -125,10 +92,6 @@ while (Testing()) {
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0));
Test($state or (undef $cursor) or 1);
}
END { unlink 'output/foo'; rmdir 'output' }

37
t/40nulls.t
View file

@ -8,15 +8,9 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver $state);
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use t::lib::Test;
use vars qw($state);
#
# Include lib.pl
@ -24,20 +18,16 @@ $test_password = '';
use DBI;
use vars qw($COL_NULLABLE);
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -52,7 +42,7 @@ my ($dbh, $table, $def, $cursor, $rv);
while (Testing()) {
#
# Connect to the database
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
or ServerError();
#
@ -79,19 +69,16 @@ while (Testing()) {
. " ( NULL, 'NULL-valued id' )"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE " . IsNull("id")))
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table WHERE id IS NULL"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV'
or $dbdriver eq 'ConfFile')
Test($state or ($rv = $cursor->fetchrow_arrayref))
or DbiError($dbh->err, $dbh->errstr);
Test($state or (!defined($$rv[0]) and defined($$rv[1])) or
$dbdriver eq 'CSV' or $dbdriver eq 'ConfFile')
Test($state or (!defined($$rv[0]) and defined($$rv[1])))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->finish)
@ -107,5 +94,3 @@ while (Testing()) {
or DbiError($dbh->err, $dbh->errstr);
}
END { unlink 'output/foo'; rmdir 'output' }

30
t/40numrows.t
View file

@ -8,34 +8,23 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $state);
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use t::lib::Test;
use vars qw($state);
#
# Include lib.pl
#
use DBI;
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN 'DBI:SQLite:dbname=foo'.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -61,8 +50,8 @@ my ($dbh, $table, $def, $cursor, $numrows);
while (Testing()) {
#
# Connect to the database
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect('DBI:SQLite:dbname=foo', '',
'')))
or ServerError();
#
@ -153,4 +142,3 @@ while (Testing()) {
}
END { unlink 'output/foo'; rmdir 'output' }

29
t/40prepcached.t
View file

@ -10,34 +10,24 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $state);
use t::lib::Test;
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
$test_password = '';
use vars qw($state);
#
# Include lib.pl
#
use DBI;
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN DBI:SQLite:dbname=foo.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -63,8 +53,8 @@ my ($dbh, $table, $def, $cursor, $sth);
while (Testing()) {
#
# Connect to the database
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
'')))
or ServerError();
#
@ -133,4 +123,3 @@ while (Testing()) {
}
END { unlink 'output/foo'; rmdir 'output' }

35
t/50chopblanks.t
View file

@ -8,37 +8,27 @@ BEGIN {
$^W = 1;
}
use t::lib::Test;
#
# Make -w happy
#
use vars qw($test_dsn $test_user $test_password $mdriver $verbose $state
$dbdriver);
use vars qw($state);
use vars qw($COL_NULLABLE $COL_KEY);
$test_dsn = '';
$test_user = '';
$test_password = '';
#
# Include lib.pl
#
use DBI;
$mdriver = "";
{
my $file;
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tpermissions for acessing the DSN DBI:SQLite:dbname=foo.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
@ -54,8 +44,8 @@ while (Testing()) {
#
# Connect to the database
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
'')))
or ServerError();
#
@ -107,9 +97,7 @@ while (Testing()) {
Test($state or defined($ref = $sth->fetchrow_arrayref))
or ErrMsgF("fetch failed: query $query, error %s.\n",
$sth->errstr);
Test($state or ($$ref[1] eq $name)
or ($name =~ /^$$ref[1]\s+$/ &&
($dbdriver eq 'mysql' || $dbdriver eq 'ODBC')))
Test($state or ($$ref[1] eq $name))
or ErrMsgF("problems with ChopBlanks = 0:"
. " expected '%s', got '%s'.\n",
$name, $$ref[1]);
@ -146,4 +134,3 @@ while (Testing()) {
or ErrMsgF("Cannot disconnect: %s.\n", $dbh->errmsg);
}
END { unlink 'output/foo'; rmdir 'output' }

51
t/50commit.t
View file

@ -8,24 +8,17 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $state);
use t::lib::Test;
use vars qw($state);
#
# Include lib.pl
#
require DBI;
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'whatever') {
print "1..0\n";
exit 0;
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
@ -65,13 +58,13 @@ my ($dbh, $def, $table, $msg);
while (Testing()) {
#
# Connect to the database
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)),
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
'')),
'connect',
"Attempting to connect.\n")
or ErrMsgF("Cannot connect: Error %s.\n\n"
. "Make sure, your database server is up and running.\n"
. "Check that '$test_dsn' references a valid database"
. "Check that 'DBI:SQLite:dbname=foo' references a valid database"
. " name.\nDBI error message: %s\n",
$DBI::err, $DBI::errstr);
@ -98,7 +91,7 @@ while (Testing()) {
#
# Tests for databases that do support transactions
#
if (HaveTransactions()) {
if ( 1 ) {
# Turn AutoCommit off
$dbh->{AutoCommit} = 0;
Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
@ -139,8 +132,8 @@ while (Testing()) {
Test($state or $dbh->disconnect)
or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
'')))
or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
$DBI::err, $DBI::errstr);
Test($state or !($msg = NumRows($dbh, $table, 0)))
@ -149,18 +142,6 @@ while (Testing()) {
# Check whether AutoCommit is on again
Test($state or $dbh->{AutoCommit})
or ErrMsg("AutoCommit is off\n");
#
# Tests for databases that don't support transactions
#
} else {
if (!$state) {
$@ = '';
eval { $dbh->{AutoCommit} = 0; }
}
Test($state or $@)
or ErrMsg("Expected fatal error for AutoCommit => 0\n",
'AutoCommit off -> error');
}
# Check whether AutoCommit mode works.
@ -172,8 +153,8 @@ while (Testing()) {
Test($state or $dbh->disconnect, 'disconnect')
or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
'')))
or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
$DBI::err, $DBI::errstr);
Test($state or !($msg = NumRows($dbh, $table, 1)))
@ -221,5 +202,3 @@ while (Testing()) {
or ErrMsgF("Cannot DROP test table $table: %s.\n",
$dbh->errstr);
}
END { unlink 'output/foo'; rmdir 'output' }

24
t/70schemachange.t
View file

@ -6,28 +6,17 @@ BEGIN {
$^W = 1;
}
use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver);
use t::lib::Test;
if ($^O eq 'MSWin32') {
print "1..0 # Skip changing active database's schema doesn't work under Windows\n";
exit 0;
}
$DBI::errstr = ''; # Make -w happy
require DBI;
# Include lib.pl
$mdriver = '';
my $file;
foreach $file ('lib.pl', 't/lib.pl') {
do $file;
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
do 't/lib.pl';
if ($@) {
print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
sub ServerError() {
@ -40,7 +29,7 @@ use vars qw($state);
while (Testing()) {
# Connect to the database
my $dbh;
Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
Test($state or $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', ''))
or ServerError();
# Create some tables
@ -100,4 +89,3 @@ while (Testing()) {
or DbiError($dbh->err, $dbh->errstr);
}
unlink 'output/foo'; rmdir 'output';

135
t/SQLite.dbtest
View file

@ -1,135 +0,0 @@
# Hej, Emacs, give us -*- perl -*- mode here!
#
# $Id: CSV.dbtest,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
#
# database specific definitions for a 'CSV' database
use strict;
# This function generates a mapping of ANSI type names to
# database specific type names; it is called by TableDefinition().
#
sub AnsiTypeToDb ($;$) {
my ($type, $size) = @_;
my ($ret);
if ((lc $type) eq 'char' || (lc $type) eq 'varchar') {
$size ||= 1;
return (uc $type) . " ($size)";
} elsif ((lc $type) eq 'blob' || (lc $type) eq 'real' ||
(lc $type) eq 'integer') {
return uc $type;
} elsif ((lc $type) eq 'int') {
return 'INTEGER';
} else {
warn "Unknown type $type\n";
$ret = $type;
}
$ret;
}
#
# This function generates a table definition based on an
# input list. The input list consists of references, each
# reference referring to a single column. The column
# reference consists of column name, type, size and a bitmask of
# certain flags, namely
#
# $COL_NULLABLE - true, if this column may contain NULL's
# $COL_KEY - true, if this column is part of the table's
# primary key
#
# Hopefully there's no big need for you to modify this function,
# if your database conforms to ANSI specifications.
#
sub TableDefinition ($@) {
my($tablename, @cols) = @_;
my($def);
#
# Should be acceptable for most ANSI conformant databases;
#
# msql 1 uses a non-ANSI definition of the primary key: A
# column definition has the attribute "PRIMARY KEY". On
# the other hand, msql 2 uses the ANSI fashion ...
#
my($col, @keys, @colDefs, $keyDef);
#
# Count number of keys
#
@keys = ();
foreach $col (@cols) {
if ($$col[2] & $::COL_KEY) {
push(@keys, $$col[0]);
}
}
foreach $col (@cols) {
my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
if (!($$col[3] & $::COL_NULLABLE)) {
$colDef .= " NOT NULL";
}
push(@colDefs, $colDef);
}
if (@keys) {
$keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
} else {
$keyDef = "";
}
$def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
join(", ", @colDefs), $keyDef);
}
#
# This function generates a list of tables associated to a
# given DSN.
#
sub ListTables(@) {
my($dbh) = shift;
my(@tables);
@tables = $dbh->func('list_tables');
if ($dbh->errstr) {
die "Cannot create table list: " . $dbh->errstr;
}
@tables;
}
#
# This function is called by DBD::pNET; given a hostname and a
# dsn without hostname, return a dsn for connecting to dsn at
# host.
sub HostDsn ($$) {
my($hostname, $dsn) = @_;
"$dsn:$hostname";
}
#
# Return a string for checking, whether a given column is NULL.
#
sub IsNull($) {
my($var) = @_;
"$var IS NULL";
}
#
# Return TRUE, if database supports transactions
#
sub HaveTransactions () {
1;
}
if (! -d "output") {
mkdir "output", 0755;
}
1;

153
t/lib.pl
View file

@ -1,73 +1,92 @@
# Hej, Emacs, give us -*- perl mode here!
#
# $Id: lib.pl,v 1.3 2002/12/19 18:35:43 matt Exp $
#
# lib.pl is the file where database specific things should live,
# whereever possible. For example, you define certain constants
# here and the like.
#
require 5.003;
use strict;
use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password
$haveFileSpec);
$| = 1; # flush stdout asap to keep in sync with stderr
#
# Driver names; EDIT THIS!
#
$mdriver = 'SQLite';
$dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver.
# The exception is DBD::pNET where we have to
# to separate between local driver (pNET) and
# the remote driver ($dbdriver)
#
# DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
#
mkdir 'output';
$haveFileSpec = eval { require File::Spec };
my $table_dir = $haveFileSpec ?
File::Spec->catdir(File::Spec->curdir(), 'output', 'foo') : 'output/foo';
$test_dsn = $ENV{'DBI_DSN'}
|| "DBI:$dbdriver:dbname=$table_dir";
$test_user = $ENV{'DBI_USER'} || "";
$test_password = $ENV{'DBI_PASS'} || "";
use File::Spec ();
use vars qw($childPid);
$::COL_NULLABLE = 1;
$::COL_KEY = 2;
# This function generates a mapping of ANSI type names to
# database specific type names; it is called by TableDefinition().
#
sub AnsiTypeToDb ($;$) {
my ($type, $size) = @_;
my ($ret);
my $file;
if (-f ($file = "t/$dbdriver.dbtest") ||
-f ($file = "$dbdriver.dbtest") ||
-f ($file = "../tests/$dbdriver.dbtest") ||
-f ($file = "tests/$dbdriver.dbtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
if (-f ($file = "t/$mdriver.mtest") ||
-f ($file = "$mdriver.mtest") ||
-f ($file = "../tests/$mdriver.mtest") ||
-f ($file = "tests/$mdriver.mtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
if ((lc $type) eq 'char' || (lc $type) eq 'varchar') {
$size ||= 1;
return (uc $type) . " ($size)";
} elsif ((lc $type) eq 'blob' || (lc $type) eq 'real' ||
(lc $type) eq 'integer') {
return uc $type;
} elsif ((lc $type) eq 'int') {
return 'INTEGER';
} else {
warn "Unknown type $type\n";
$ret = $type;
}
$ret;
}
#
# This function generates a table definition based on an
# input list. The input list consists of references, each
# reference referring to a single column. The column
# reference consists of column name, type, size and a bitmask of
# certain flags, namely
#
# $COL_NULLABLE - true, if this column may contain NULL's
# $COL_KEY - true, if this column is part of the table's
# primary key
#
# Hopefully there's no big need for you to modify this function,
# if your database conforms to ANSI specifications.
#
sub TableDefinition ($@) {
my($tablename, @cols) = @_;
my($def);
#
# Should be acceptable for most ANSI conformant databases;
#
# msql 1 uses a non-ANSI definition of the primary key: A
# column definition has the attribute "PRIMARY KEY". On
# the other hand, msql 2 uses the ANSI fashion ...
#
my($col, @keys, @colDefs, $keyDef);
#
# Count number of keys
#
@keys = ();
foreach $col (@cols) {
if ($$col[2] & $::COL_KEY) {
push(@keys, $$col[0]);
}
}
foreach $col (@cols) {
my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
if (!($$col[3] & $::COL_NULLABLE)) {
$colDef .= " NOT NULL";
}
push(@colDefs, $colDef);
}
if (@keys) {
$keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
} else {
$keyDef = "";
}
$def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
join(", ", @colDefs), $keyDef);
}
open (STDERR, ">&STDOUT") || die "Cannot redirect stderr" ;
select (STDERR) ; $| = 1 ;
select (STDOUT) ; $| = 1 ;
@ -201,18 +220,7 @@ sub DbiError ($$) {
# This functions generates a list of possible DSN's aka
# databases and returns a possible table name for a new
# table being created.
#
# Problem is, we have two different situations here: Test scripts
# call us by pasing a dbh, which is fine for most situations.
# From within DBD::pNET, however, the dbh isn't that meaningful.
# Thus we are working with the global variable $listTablesHook:
# Once defined, we call &$listTablesHook instead of ListTables.
#
# See DBD::pNET/t/pNET.mtest for details.
#
{
use vars qw($listTablesHook);
SCOPE: {
my(@tables, $testtable, $listed);
$testtable = "testaa";
@ -222,13 +230,10 @@ sub DbiError ($$) {
my($dbh) = @_;
if (!$listed) {
if (defined($listTablesHook)) {
@tables = &$listTablesHook($dbh);
} elsif (defined(&ListTables)) {
@tables = &ListTables($dbh);
} else {
die "Fatal: ListTables not implemented.\n";
}
@tables = $dbh->func('list_tables');
if ($dbh->errstr) {
die "Cannot create table list: " . $dbh->errstr;
}
$listed = 1;
}

30
t/lib/Test.pm
View file

@ -3,19 +3,24 @@ package t::lib::Test;
# Support code for DBD::SQLite tests
use strict;
use Exporter ();
use File::Spec ();
use Test::More ();
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
$VERSION = '1.19_06';
@ISA = qw{ Exporter };
@EXPORT = qw{ connect_ok };
}
# Always load the DBI module
use DBI ();
# Delete temporary files
sub clean {
my @files = qw{
foo
foo-journal
};
foreach my $file ( @files ) {
unlink $file if -e $file;
}
unlink( 'foo' );
unlink( 'foo-journal' );
}
# Clean up temporary test files both at the beginning and end of the
@ -23,4 +28,15 @@ sub clean {
BEGIN { clean() }
END { clean() }
# A simplified connect function for the most common case
sub connect_ok {
my @params = ( "dbi:SQLite:dbname=foo", "", "" );
if ( @_ ) {
push @params, { @_ };
}
my $dbh = DBI->connect( @params );
Test::More::isa_ok( $dbh, 'DBI::db' );
return $dbh;
}
1;