mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 22:28:47 -04:00
Completed the migration away from and deprecation of t/lib.pl
This commit is contained in:
Adam Kennedy
parent
22877e97e9
commit
51bd0c50ff
16 changed files with 440 additions and 1148 deletions
6
Changes
6
Changes
|
|
@ -1,6 +1,10 @@
|
||||||
Changes for Perl extension DBD-SQLite.
|
Changes for Perl extension DBD-SQLite.
|
||||||
|
|
||||||
1.22_07 not yet released
|
1.22_08 not yet released
|
||||||
|
- Completed the migration of all tests and deleted lib.pl (ADAMK)
|
||||||
|
- Prevented a double "commit is innefective" warning (ADAMK)
|
||||||
|
|
||||||
|
1.22_07 Thu 16 Apr 2009
|
||||||
- Improved non-latin unicode filename support/test
|
- Improved non-latin unicode filename support/test
|
||||||
on Windows (SZABGAB/ISHIGAKI)
|
on Windows (SZABGAB/ISHIGAKI)
|
||||||
- Removed the table name generator from t/lib.pl,
|
- Removed the table name generator from t/lib.pl,
|
||||||
|
|
|
||||||
303
t/15_ak_dbd.t
303
t/15_ak_dbd.t
|
|
@ -7,219 +7,132 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 37;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
#
|
# Create a database
|
||||||
# Make -w happy
|
my $dbh = connect_ok( RaiseError => 1, PrintError => 1, PrintWarn => 1 );
|
||||||
#
|
|
||||||
use vars qw($state);
|
|
||||||
use vars qw($COL_NULLABLE $COL_KEY);
|
|
||||||
|
|
||||||
#
|
# Create the table
|
||||||
# Include lib.pl
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
#
|
CREATE TABLE one (
|
||||||
require "t/lib.pl";
|
id INTEGER NOT NULL,
|
||||||
|
name CHAR (64)
|
||||||
|
)
|
||||||
|
END_SQL
|
||||||
|
|
||||||
#
|
# Test quoting
|
||||||
# Main loop; leave this untouched, put tests after creating
|
my $quoted = $dbh->quote('test1');
|
||||||
# the new table.
|
is( $quoted, "'test1'", '->quote(test1) ok' );
|
||||||
#
|
|
||||||
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('DBI:SQLite:dbname=foo', '', '')))
|
|
||||||
or ErrMsg("Cannot connect: $DBI::errstr.\n");
|
|
||||||
|
|
||||||
#
|
# Disconnect
|
||||||
# Find a possible new table name
|
ok( $dbh->disconnect, '->disconnect' );
|
||||||
#
|
|
||||||
Test($state or $test_table = 'table1') or 1
|
|
||||||
or ErrMsg("Cannot get table name: $dbh->errstr.\n");
|
|
||||||
|
|
||||||
#
|
# Reconnect
|
||||||
# Create a new table; EDIT THIS!
|
$dbh = connect_ok();
|
||||||
#
|
|
||||||
Test($state or ($query = TableDefinition($test_table,
|
|
||||||
["id", "INTEGER", 4, $COL_NULLABLE],
|
|
||||||
["name", "CHAR", 64, $COL_NULLABLE]),
|
|
||||||
$dbh->do($query)))
|
|
||||||
or ErrMsg("Cannot create table: query $query error $dbh->errstr.\n");
|
|
||||||
|
|
||||||
#
|
# Delete the table and recreate it
|
||||||
# and here's the right place for inserting new tests:
|
ok( $dbh->do('DROP TABLE one'), 'DROP' );
|
||||||
#
|
|
||||||
Test($state or $dbh->quote('tast1'))
|
|
||||||
or ErrMsgF("quote('tast1') returned %s.\n", $dbh->quote('tast1'));
|
|
||||||
|
|
||||||
### ...and disconnect
|
# Create the table again
|
||||||
Test($state or $dbh->disconnect)
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
or ErrMsg("\$dbh->disconnect() failed!\n",
|
CREATE TABLE one (
|
||||||
"Make sure your server is still functioning",
|
id INTEGER NULL,
|
||||||
"correctly, and check to make\n",
|
name CHAR (64) NULL
|
||||||
"sure your network isn\'t malfunctioning in the",
|
)
|
||||||
"case of the server running on a remote machine.\n");
|
END_SQL
|
||||||
|
|
||||||
### Now, re-connect again so that we can do some more complicated stuff..
|
# Insert into table
|
||||||
Test($state or ($dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '')))
|
ok( $dbh->do("INSERT INTO one VALUES ( 1, 'A' )"), 'INSERT 1' );
|
||||||
or ErrMsg("reconnect failed: $DBI::errstr\n");
|
|
||||||
|
|
||||||
Test($state or $dbh->do("DROP TABLE $test_table"))
|
# Delete it
|
||||||
or ErrMsg("Dropping table failed: $dbh->errstr.\n");
|
ok( $dbh->do('DELETE FROM one WHERE id = 1'), 'DELETE 1' );
|
||||||
Test($state or ($query = TableDefinition($test_table,
|
|
||||||
["id", "INTEGER", 4, $COL_NULLABLE],
|
|
||||||
["name", "CHAR", 64, $COL_NULLABLE]),
|
|
||||||
$dbh->do($query)))
|
|
||||||
or ErrMsg("create failed, query $query, error $dbh->errstr.\n");
|
|
||||||
|
|
||||||
### Insert a row into the test table.......
|
# When we "forget" execute, fail with error message
|
||||||
print "Inserting a row...\n";
|
SCOPE: {
|
||||||
Test($state or ($dbh->do("INSERT INTO $test_table VALUES(1,"
|
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||||
. " 'Alligator Descartes')")))
|
isa_ok( $sth, 'DBI::st' );
|
||||||
or ErrMsg("INSERT failed: $dbh->errstr.\n");
|
my ($pe) = $sth->{PrintError};
|
||||||
|
$sth->{PrintError} = 0;
|
||||||
### ...and delete it........
|
my $rv = eval {
|
||||||
print "Deleting a row...\n";
|
$sth->fetchrow;
|
||||||
Test($state or $dbh->do("DELETE FROM $test_table WHERE id = 1"))
|
};
|
||||||
or ErrMsg("Cannot delete row: $dbh->errstr.\n");
|
$sth->{PrintError} = $pe;
|
||||||
Test($state or ($sth = $dbh->prepare("SELECT * FROM $test_table"
|
ok( $sth->execute, '->execute' );
|
||||||
. " WHERE id = 1")))
|
|
||||||
or ErrMsg("Cannot select: $dbh->errstr.\n");
|
|
||||||
|
|
||||||
# This should fail with error message: We "forgot" execute.
|
|
||||||
my($pe) = $sth->{'PrintError'};
|
|
||||||
$sth->{'PrintError'} = 0;
|
|
||||||
Test($state or !eval { $sth->fetchrow() })
|
|
||||||
or ErrMsg("Missing error report from fetchrow.\n");
|
|
||||||
$sth->{'PrintError'} = $pe;
|
|
||||||
|
|
||||||
Test($state or $sth->execute)
|
|
||||||
or ErrMsg("execute SELECT failed: $dbh->errstr.\n");
|
|
||||||
|
|
||||||
# This should fail without error message: No rows returned.
|
# This should fail without error message: No rows returned.
|
||||||
my(@row, $ref);
|
my(@row, $ref);
|
||||||
{
|
SCOPE: {
|
||||||
local($^W) = 0;
|
local $^W = 0;
|
||||||
Test($state or !defined($ref = $sth->fetch))
|
is( $sth->fetch, undef, '->fetch returns undef' );
|
||||||
or ErrMsgF("Unexpected row returned by fetchrow: $ref\n".
|
}
|
||||||
scalar(@row));
|
ok( $sth->finish, '->finish' );
|
||||||
}
|
}
|
||||||
|
|
||||||
# Now try a "finish"
|
# This section should exercise the sth->func( '_NumRows' ) private
|
||||||
Test($state or $sth->finish)
|
# method by preparing a statement, then finding the number of rows
|
||||||
or ErrMsg("sth->finish failed: $sth->errstr.\n");
|
# within it. Prior to execution, this should fail. After execution,
|
||||||
|
# the number of rows affected by the statement will be returned.
|
||||||
# Call destructors:
|
SCOPE: {
|
||||||
Test($state or (undef $sth || 1));
|
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
### This section should exercise the sth->func( '_NumRows' ) private
|
is( $sth->rows, -1, '->rows is negative' );
|
||||||
### method by preparing a statement, then finding the number of rows
|
ok( $sth->execute, '->execute ok' );
|
||||||
### within it. Prior to execution, this should fail. After execution,
|
is( $sth->rows, 0, '->rows returns 0' );
|
||||||
### the number of rows affected by the statement will be returned.
|
ok( $sth->finish, '->finish' );
|
||||||
Test($state or ($dbh->do($query = "INSERT INTO $test_table VALUES"
|
|
||||||
. " (1, 'Alligator Descartes' )")))
|
|
||||||
or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
|
|
||||||
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 (!$state) {
|
|
||||||
print "Test 19: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
|
|
||||||
}
|
}
|
||||||
Test($state or $sth->execute)
|
|
||||||
or ErrMsgF("execute failed: query $query, error %s.\n", $sth->errstr);
|
|
||||||
Test($state or ($sth->rows == 0) or ($sth->rows == -1))
|
|
||||||
or ErrMsgF("sth->rows returned wrong result %s after 'execute'.\n",
|
|
||||||
$sth->rows);
|
|
||||||
Test($state or $sth->finish)
|
|
||||||
or ErrMsgF("finish failed: %s.\n", $sth->errstr);
|
|
||||||
Test($state or (undef $sth or 1));
|
|
||||||
|
|
||||||
### Test whether or not a field containing a NULL is returned correctly
|
# Test whether or not a field containing a NULL is returned correctly
|
||||||
### as undef, or something much more bizarre
|
# as undef, or something much more bizarre
|
||||||
$query = "INSERT INTO $test_table VALUES ( NULL, 'NULL-valued id' )";
|
ok( $dbh->do("INSERT INTO one VALUES ( NULL, 'NULL-valued id' )"), 'INSERT 2' );
|
||||||
Test($state or $dbh->do($query))
|
SCOPE: {
|
||||||
or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
|
my $sth = $dbh->prepare("SELECT id FROM one WHERE id IS NULL");
|
||||||
$query = "SELECT id FROM $test_table WHERE id IS NULL";
|
isa_ok( $sth, 'DBI::st' );
|
||||||
Test($state or ($sth = $dbh->prepare($query)))
|
ok( $sth->execute, '->execute' );
|
||||||
or ErrMsgF("Cannot prepare, query = $query, error %s.\n",
|
is_deeply(
|
||||||
$dbh->errstr);
|
$sth->fetchall_arrayref,
|
||||||
if (!$state) {
|
[ [ undef ] ],
|
||||||
print "Test 25: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
|
'NULL returned ok',
|
||||||
|
);
|
||||||
|
ok( $sth->finish, '->finish' );
|
||||||
}
|
}
|
||||||
Test($state or $sth->execute)
|
|
||||||
or ErrMsgF("Cannot execute, query = $query, error %s.\n",
|
|
||||||
$dbh->errstr);
|
|
||||||
my $rv;
|
|
||||||
Test($state or !defined($$rv[0]))
|
|
||||||
or ErrMsgF("Expected NULL value, got %s.\n", $$rv[0]);
|
|
||||||
Test($state or $sth->finish)
|
|
||||||
or ErrMsgF("finish failed: %s.\n", $sth->errstr);
|
|
||||||
Test($state or undef $sth or 1);
|
|
||||||
|
|
||||||
### Delete the test row from the table
|
# Delete the test row from the table
|
||||||
$query = "DELETE FROM $test_table WHERE id = NULL AND"
|
ok( $dbh->do("DELETE FROM one WHERE id is NULL AND name = 'NULL-valued id'"), 'DELETE' );
|
||||||
. " name = 'NULL-valued id'";
|
|
||||||
Test($state or ($rv = $dbh->do($query)))
|
|
||||||
or ErrMsg("DELETE failed: query $query, error %s.\n", $dbh->errstr);
|
|
||||||
|
|
||||||
### Test whether or not a char field containing a blank is returned
|
|
||||||
### correctly as blank, or something much more bizarre
|
|
||||||
$query = "INSERT INTO $test_table VALUES (2, NULL)";
|
|
||||||
Test($state or $dbh->do($query))
|
|
||||||
or ErrMsg("INSERT failed: query $query, error %s.\n", $dbh->errstr);
|
|
||||||
$query = "SELECT name FROM $test_table WHERE id = 2 AND name IS NULL";
|
|
||||||
|
|
||||||
Test($state or ($sth = $dbh->prepare($query)))
|
|
||||||
or ErrMsg("prepare failed: query $query, error %s.\n", $dbh->errstr);
|
|
||||||
Test($state or $sth->execute)
|
|
||||||
or ErrMsg("execute failed: query $query, error %s.\n", $dbh->errstr);
|
|
||||||
$rv = undef;
|
|
||||||
Test($state or defined($ref = $sth->fetch))
|
|
||||||
or ErrMsgF("fetchrow failed: query $query, error %s.\n", $sth->errstr);
|
|
||||||
Test($state or !defined($$ref[0]) )
|
|
||||||
or ErrMsgF("blank value returned as [%s].\n", $$ref[0]);
|
|
||||||
Test($state or $sth->finish)
|
|
||||||
or ErrMsg("finish failed: $sth->errmsg.\n");
|
|
||||||
Test($state or undef $sth or 1);
|
|
||||||
|
|
||||||
### Delete the test row from the table
|
|
||||||
$query = "DELETE FROM $test_table WHERE id = 2 AND name IS NULL";
|
|
||||||
Test($state or $dbh->do($query))
|
|
||||||
or ErrMsg("DELETE failed: query $query, error $dbh->errstr.\n");
|
|
||||||
|
|
||||||
### Test the new funky routines to list the fields applicable to a SELECT
|
|
||||||
### statement, and not necessarily just those in a table...
|
|
||||||
$query = "SELECT * FROM $test_table";
|
|
||||||
Test($state or ($sth = $dbh->prepare($query)))
|
|
||||||
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");
|
|
||||||
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')
|
|
||||||
or ErrMsg("Query returned no result, query $query,",
|
|
||||||
" error $sth->errstr.\n");
|
|
||||||
Test($state or $sth->finish)
|
|
||||||
or ErrMsg("finish failed: $sth->errmsg.\n");
|
|
||||||
Test($state or undef $sth or 1);
|
|
||||||
|
|
||||||
### Insert some more data into the test table.........
|
|
||||||
$query = "INSERT INTO $test_table VALUES( 2, 'Gary Shea' )";
|
|
||||||
Test($state or $dbh->do($query))
|
|
||||||
or ErrMsg("INSERT failed: query $query, error $dbh->errstr.\n");
|
|
||||||
$query = "UPDATE $test_table SET id = 3 WHERE name = 'Gary Shea'";
|
|
||||||
Test($state or ($sth = $dbh->prepare($query)))
|
|
||||||
or ErrMsg("prepare failed: query $query, error $sth->errmsg.\n");
|
|
||||||
# This should fail: We "forgot" execute.
|
|
||||||
Test($state or undef $sth or 1);
|
|
||||||
|
|
||||||
### Drop the test table out of our database to clean up.........
|
|
||||||
$query = "DROP TABLE $test_table";
|
|
||||||
Test($state or $dbh->do($query))
|
|
||||||
or ErrMsg("DROP failed: query $query, error $dbh->errstr.\n");
|
|
||||||
|
|
||||||
Test($state or $dbh->disconnect)
|
|
||||||
or ErrMsg("disconnect failed: $dbh->errstr.\n");
|
|
||||||
|
|
||||||
|
# Test whether or not a char field containing a blank is returned
|
||||||
|
# correctly as blank, or something much more bizarre
|
||||||
|
ok( $dbh->do("INSERT INTO one VALUES ( 2, NULL )"), 'INSERT 3' );
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("SELECT name FROM one WHERE id = 2 AND name IS NULL");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
ok( $sth->execute, '->execute' );
|
||||||
|
is_deeply(
|
||||||
|
$sth->fetchall_arrayref,
|
||||||
|
[ [ undef ] ],
|
||||||
|
'->fetchall_arrayref',
|
||||||
|
);
|
||||||
|
ok( $sth->finish, '->finish' );
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Delete the test row from the table
|
||||||
|
ok( $dbh->do('DELETE FROM ONE WHERE id = 2 AND name IS NULL'), 'DELETE' );
|
||||||
|
|
||||||
|
# Test the new funky routines to list the fields applicable to a SELECT
|
||||||
|
# statement, and not necessarily just those in a table...
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("SELECT * FROM one");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
ok( $sth->execute, 'Execute' );
|
||||||
|
ok( $sth->execute, 'Reexecute' );
|
||||||
|
my @row = $sth->fetchrow_array;
|
||||||
|
ok( $sth->finish, '->finish' );
|
||||||
|
}
|
||||||
|
|
||||||
|
# Insert some more data into the test table.........
|
||||||
|
ok( $dbh->do("INSERT INTO one VALUES( 2, 'Gary Shea' )"), 'INSERT 4' );
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("UPDATE one SET id = 3 WHERE name = 'Gary Shea'");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -9,131 +9,40 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 10;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
use vars qw($state);
|
# Create a database
|
||||||
|
my $dbh = connect_ok( RaiseError => 1 );
|
||||||
#
|
|
||||||
# Include lib.pl
|
|
||||||
#
|
|
||||||
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 '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");
|
|
||||||
exit 10;
|
|
||||||
}
|
|
||||||
|
|
||||||
#
|
|
||||||
# Main loop; leave this untouched, put tests after creating
|
|
||||||
# the new table.
|
|
||||||
#
|
|
||||||
my ($dbh, $def, $table, $cursor);
|
|
||||||
while (Testing()) {
|
|
||||||
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
|
|
||||||
'connect')
|
|
||||||
or ServerError();
|
|
||||||
|
|
||||||
#
|
|
||||||
# Find a possible new table name
|
|
||||||
#
|
|
||||||
Test($state or $table = 'table1')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Create a new table; EDIT THIS!
|
|
||||||
#
|
|
||||||
Test($state or ($def = TableDefinition($table,
|
|
||||||
["id", "INTEGER", 4, 0],
|
|
||||||
["name", "CHAR", 64, 0],
|
|
||||||
["val", "INTEGER", 4, 0],
|
|
||||||
["txt", "CHAR", 64, 0]) and
|
|
||||||
$dbh->do($def)), 'create', $def)
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Insert a row into the test table.......
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("INSERT INTO $table"
|
|
||||||
. " VALUES(1, 'Alligator Descartes', 1111,"
|
|
||||||
. " 'Some Text')"), 'insert')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Now, try SELECT'ing the row out.
|
|
||||||
#
|
|
||||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
|
|
||||||
. " WHERE id = 1"),
|
|
||||||
'prepare select')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->execute, 'execute select')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
my ($row, $errstr);
|
|
||||||
Test($state or (defined($row = $cursor->fetchrow_arrayref) &&
|
|
||||||
!($cursor->errstr)), 'fetch select')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or ($row->[0] == 1 &&
|
|
||||||
$row->[1] eq 'Alligator Descartes' &&
|
|
||||||
$row->[2] == 1111 &&
|
|
||||||
$row->[3] eq 'Some Text'), 'compare select')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->finish, 'finish select')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or undef $cursor || 1, 'undef select');
|
|
||||||
|
|
||||||
#
|
|
||||||
# ...and delete it........
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"), 'delete')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Now, try SELECT'ing the row out. This should fail.
|
|
||||||
#
|
|
||||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
|
|
||||||
. " WHERE id = 1"),
|
|
||||||
'prepare select deleted')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->execute, 'execute select deleted')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or (!defined($row = $cursor->fetchrow_arrayref) &&
|
|
||||||
(!defined($errstr = $cursor->errstr) ||
|
|
||||||
$cursor->errstr eq '')), 'fetch select deleted')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or (!defined($row = $cursor->fetchrow_arrayref) &&
|
|
||||||
(!defined($errstr = $cursor->errstr) ||
|
|
||||||
$cursor->errstr eq '')), 'fetch on empty statement handler')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->finish, 'finish select deleted')
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or undef $cursor || 1, 'undef select deleted');
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Finally drop the test table.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DROP TABLE $table"), 'drop')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
# Create the table
|
||||||
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
|
CREATE TABLE one (
|
||||||
|
id INTEGER NOT NULL,
|
||||||
|
name CHAR (64) NOT NULL
|
||||||
|
)
|
||||||
|
END_SQL
|
||||||
|
|
||||||
|
# Insert a row
|
||||||
|
ok( $dbh->do("INSERT INTO one VALUES ( 1, 'A' )"), 'INSERT' );
|
||||||
|
|
||||||
|
# Now SELECT the row out
|
||||||
|
is_deeply(
|
||||||
|
$dbh->selectall_arrayref('SELECT * FROM one WHERE id = 1'),
|
||||||
|
[ [ 1, 'A' ] ],
|
||||||
|
'SELECT ok',
|
||||||
|
);
|
||||||
|
|
||||||
|
# Delete the row
|
||||||
|
ok( $dbh->do("DELETE FROM one WHERE id = 1"), 'DELETE' );
|
||||||
|
|
||||||
|
# Select an empty result
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
ok( $sth->execute, '->execute' );
|
||||||
|
my $row1 = $sth->fetchrow_arrayref;
|
||||||
|
is( $row1, undef, 'fetch select deleted' );
|
||||||
|
my $row2 = $sth->fetchrow_arrayref;
|
||||||
|
is( $row2, undef, 'fetch empty statement handler' );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
216
t/19_bindparam.t
216
t/19_bindparam.t
|
|
@ -7,178 +7,72 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 33;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
use DBI ':sql_types';
|
||||||
|
|
||||||
use vars qw($state);
|
# Create a database
|
||||||
|
my $dbh = connect_ok( RaiseError => 1, PrintError => 1, PrintWarn => 1 );
|
||||||
|
|
||||||
#
|
# Create the table
|
||||||
# Include lib.pl
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
#
|
CREATE TABLE one (
|
||||||
use vars qw($COL_NULLABLE);
|
id INTEGER NOT NULL,
|
||||||
do 't/lib.pl';
|
name CHAR (64) NULL
|
||||||
if ($@) {
|
)
|
||||||
print STDERR "Error while executing lib.pl: $@\n";
|
END_SQL
|
||||||
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 '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");
|
|
||||||
exit 10;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (!defined(&SQL_VARCHAR)) {
|
|
||||||
eval "sub SQL_VARCHAR { 12 }";
|
|
||||||
}
|
|
||||||
if (!defined(&SQL_INTEGER)) {
|
|
||||||
eval "sub SQL_INTEGER { 4 }";
|
|
||||||
}
|
|
||||||
|
|
||||||
#
|
|
||||||
# Main loop; leave this untouched, put tests after creating
|
|
||||||
# the new table.
|
|
||||||
#
|
|
||||||
my ($dbh, $def, $table, $cursor, $id, $name, $ref);
|
|
||||||
while (Testing()) {
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
|
|
||||||
'connect')
|
|
||||||
or ServerError();
|
|
||||||
|
|
||||||
# For some reason this test is fscked with the utf8 flag on.
|
|
||||||
# It seems to be because the string "K\x{00f6}nig" which to
|
|
||||||
# me looks like unicode, should set the UTF8 flag on that
|
|
||||||
# scalar. But no. It doesn't. Stupid fscking piece of crap.
|
|
||||||
# (the test works if I manually set that flag with utf8::upgrade())
|
|
||||||
# $dbh->{NoUTF8Flag} = 1 if $] > 5.007;
|
|
||||||
|
|
||||||
#
|
|
||||||
# Find a possible new table name
|
|
||||||
#
|
|
||||||
Test($state or $table = 'table1')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Create a new table; EDIT THIS!
|
|
||||||
#
|
|
||||||
Test($state or ($def = TableDefinition($table,
|
|
||||||
["r_id", "INTEGER", 4, 0],
|
|
||||||
["name", "CHAR", 64, $COL_NULLABLE]) and
|
|
||||||
$dbh->do($def)), 'create', $def)
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
|
||||||
Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
|
|
||||||
. " VALUES (?, ?)"), 'prepare')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Insert some rows
|
|
||||||
#
|
|
||||||
|
|
||||||
my $konig = "Andreas K\xf6nig";
|
my $konig = "Andreas K\xf6nig";
|
||||||
# warn("Konig: $konig\n");
|
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("INSERT INTO one VALUES ( ?, ? )");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
|
||||||
# Automatic type detection
|
# Automatic type detection
|
||||||
my $numericVal = 1;
|
my $number = 1;
|
||||||
my $charVal = "Alligator Descartes";
|
my $char = "A";
|
||||||
Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 1')
|
ok( $sth->execute($number, $char), 'EXECUTE 1' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
# Does the driver remember the automatically detected type?
|
# Does the driver remember the automatically detected type?
|
||||||
Test($state or $cursor->execute("3", "Jochen Wiedmann"),
|
ok( $sth->execute("3", "Jochen Wiedmann"), 'EXECUTE 2' );
|
||||||
'execute insert num as string')
|
$number = 2;
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
$char = "Tim Bunce";
|
||||||
$numericVal = 2;
|
ok( $sth->execute($number, $char), 'EXECUTE 3');
|
||||||
$charVal = "Tim Bunce";
|
|
||||||
Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 2')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
# Now try the explicit type settings
|
# Now try the explicit type settings
|
||||||
Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()), 'bind 1')
|
ok( $sth->bind_param(1, " 4", SQL_INTEGER), 'bind 1' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
ok( $sth->bind_param(2, $konig), 'bind 2' );
|
||||||
Test($state or $cursor->bind_param(2, $konig), 'bind 2')
|
ok( $sth->execute, '->execute' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
Test($state or $cursor->execute, 'execute binds')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
# Works undef -> NULL?
|
# Works undef -> NULL?
|
||||||
Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
|
ok( $sth->bind_param(1, 5, SQL_INTEGER), 'bind 3' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
ok( $sth->bind_param(2, undef), 'bind 4' );
|
||||||
Test($state or $cursor->bind_param(2, undef))
|
ok( $sth->execute, '->execute' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
Test($state or $cursor->execute)
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
|
||||||
Test($state or $cursor -> finish, 'finish');
|
|
||||||
|
|
||||||
Test($state or undef $cursor || 1, 'undef cursor');
|
|
||||||
|
|
||||||
Test($state or $dbh -> disconnect, 'disconnect');
|
|
||||||
|
|
||||||
Test($state or undef $dbh || 1, 'undef dbh');
|
|
||||||
|
|
||||||
#
|
|
||||||
# And now retreive the rows using bind_columns
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
#
|
|
||||||
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''),
|
|
||||||
'connect for read')
|
|
||||||
or ServerError();
|
|
||||||
|
|
||||||
# $dbh->{NoUTF8Flag} = 1 if $] > 5.007;
|
|
||||||
|
|
||||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
|
|
||||||
. " ORDER BY abs(r_id)"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->execute)
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $cursor->bind_columns(undef, \$id, \$name))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or ($ref = $cursor->fetch) && $id == 1 &&
|
|
||||||
$name eq 'Alligator Descartes')
|
|
||||||
or printf("Alligator Query returned id = %s, name = %s, ref = %s, %d\n",
|
|
||||||
$id, $name, $ref, scalar(@$ref));
|
|
||||||
|
|
||||||
Test($state or (($ref = $cursor->fetch) && $id == 2 &&
|
|
||||||
$name eq 'Tim Bunce'))
|
|
||||||
or printf("Tim Query returned id = %s, name = %s, ref = %s, %d\n",
|
|
||||||
$id, $name, $ref, scalar(@$ref));
|
|
||||||
|
|
||||||
Test($state or (($ref = $cursor->fetch) && $id == 3 &&
|
|
||||||
$name eq 'Jochen Wiedmann'))
|
|
||||||
or printf("Jochen Query returned id = %s, name = %s, ref = %s, %d\n",
|
|
||||||
$id, $name, $ref, scalar(@$ref));
|
|
||||||
|
|
||||||
# warn("Konig: $konig\n");
|
|
||||||
Test($state or (($ref = $cursor->fetch) && $id == 4 &&
|
|
||||||
$name eq $konig))
|
|
||||||
or printf("Andreas Query returned id = %s, name = %s, ref = %s, %d\n",
|
|
||||||
$id, $name, $ref, scalar(@$ref));
|
|
||||||
|
|
||||||
# warn("$konig == $name ?\n");
|
|
||||||
Test($state or (($ref = $cursor->fetch) && $id == 5 &&
|
|
||||||
!defined($name)))
|
|
||||||
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
|
|
||||||
$id, $name, $ref, scalar(@$ref));
|
|
||||||
|
|
||||||
Test($state or undef $cursor or 1);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Finally drop the test table.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DROP TABLE $table"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Reconnect
|
||||||
|
ok( $dbh->disconnect, '->disconnect' );
|
||||||
|
$dbh = connect_ok();
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("SELECT * FROM one ORDER BY id");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
ok( $sth->execute, '->execute' );
|
||||||
|
my $id = undef;
|
||||||
|
my $name = undef;
|
||||||
|
ok( $sth->bind_columns(undef, \$id, \$name), '->bind_columns' );
|
||||||
|
ok( $sth->fetch, '->fetch' );
|
||||||
|
is( $id, 1, 'id = 1' );
|
||||||
|
is( $name, 'A', 'name = A' );
|
||||||
|
ok( $sth->fetch, '->fetch' );
|
||||||
|
is( $id, 2, 'id = 2' );
|
||||||
|
is( $name, 'Tim Bunce', 'name = Tim Bunce' );
|
||||||
|
ok( $sth->fetch, '->fetch' );
|
||||||
|
is( $id, 3, 'id = 3' );
|
||||||
|
is( $name, 'Jochen Wiedmann', 'name = Jochen Wiedmann' );
|
||||||
|
ok( $sth->fetch, '->fetch' );
|
||||||
|
is( $id, 4, 'id = 4' );
|
||||||
|
is( $name, $konig, 'name = $konig' );
|
||||||
|
ok( $sth->fetch, '->fetch' );
|
||||||
|
is( $id, 5, 'id = 5' );
|
||||||
|
is( $name, undef, 'name = undef' );
|
||||||
|
}
|
||||||
|
|
|
||||||
144
t/20_blobs.t
144
t/20_blobs.t
|
|
@ -10,33 +10,9 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 10;
|
||||||
use vars qw($state);
|
use Test::NoWarnings;
|
||||||
|
use DBI ':sql_types';
|
||||||
|
|
||||||
#
|
|
||||||
# Include lib.pl
|
|
||||||
#
|
|
||||||
|
|
||||||
use DBI qw(:sql_types);
|
|
||||||
|
|
||||||
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 '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");
|
|
||||||
exit 10;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub ShowBlob($) {
|
sub ShowBlob($) {
|
||||||
my ($blob) = @_;
|
my ($blob) = @_;
|
||||||
|
|
@ -58,102 +34,44 @@ sub ShowBlob($) {
|
||||||
if ($ENV{SHOW_BLOBS}) { close(OUT) }
|
if ($ENV{SHOW_BLOBS}) { close(OUT) }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Create a database
|
||||||
#
|
my $dbh = connect_ok();
|
||||||
# Main loop; leave this untouched, put tests after creating
|
|
||||||
# the new table.
|
|
||||||
#
|
|
||||||
my ($dbh, $table, $cursor, $row);
|
|
||||||
while (Testing()) {
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
|
|
||||||
or ServerError();
|
|
||||||
|
|
||||||
|
|
||||||
$dbh->{sqlite_handle_binary_nulls} = 1;
|
$dbh->{sqlite_handle_binary_nulls} = 1;
|
||||||
|
|
||||||
#
|
# Create the table
|
||||||
# Find a possible new table name
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
#
|
CREATE TABLE one (
|
||||||
Test($state or $table = 'table1')
|
id INTEGER NOT NULL,
|
||||||
or DbiError($dbh->error, $dbh->errstr);
|
name BLOB (128) NOT NULL
|
||||||
|
)
|
||||||
|
END_SQL
|
||||||
|
|
||||||
my($def);
|
|
||||||
foreach my $size (128) {
|
|
||||||
#
|
|
||||||
# Create a new table
|
|
||||||
#
|
|
||||||
if (!$state) {
|
|
||||||
$def = TableDefinition($table,
|
|
||||||
["id", "INTEGER", 4, 0],
|
|
||||||
["name", "BLOB", $size, 0]);
|
|
||||||
print "Creating table:\n$def\n";
|
|
||||||
}
|
|
||||||
Test($state or $dbh->do($def))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Create a blob
|
# Create a blob
|
||||||
#
|
my $blob = '';
|
||||||
my ($blob, $qblob) = "";
|
my $b = '';
|
||||||
if (!$state) {
|
|
||||||
my $b = "";
|
|
||||||
for ( my $j = 0; $j < 256; $j++ ) {
|
for ( my $j = 0; $j < 256; $j++ ) {
|
||||||
$b .= chr($j);
|
$b .= chr($j);
|
||||||
}
|
}
|
||||||
for (my $i = 0; $i < $size; $i++) {
|
for ( my $i = 0; $i < 128; $i++ ) {
|
||||||
$blob .= $b;
|
$blob .= $b;
|
||||||
}
|
}
|
||||||
$qblob = $dbh->quote($blob);
|
|
||||||
|
# Insert a row into the test table
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare("INSERT INTO one VALUES ( 1, ? )");
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
ok( $sth->bind_param(1, $blob, SQL_BLOB), '->bind_param' );
|
||||||
|
ok( $sth->execute, '->execute' );
|
||||||
}
|
}
|
||||||
|
|
||||||
#
|
|
||||||
# Insert a row into the test table.......
|
|
||||||
#
|
|
||||||
my($query, $sth);
|
|
||||||
if (!$state) {
|
|
||||||
$query = "INSERT INTO $table VALUES (1, ?)";
|
|
||||||
if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
|
|
||||||
print OUT $query, "\n";
|
|
||||||
close(OUT);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
Test($state or ($sth = $dbh->prepare($query)))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
Test($state or $sth->bind_param(1, $blob, SQL_BLOB))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
Test($state or $sth->execute())
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Now, try SELECT'ing the row out.
|
# Now, try SELECT'ing the row out.
|
||||||
#
|
SCOPE: {
|
||||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
|
my $sth = $dbh->prepare("SELECT * FROM one WHERE id = 1");
|
||||||
. " WHERE id = 1"))
|
isa_ok( $sth, 'DBI::st' );
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
ok( $sth->execute, '->execute' );
|
||||||
|
ok(
|
||||||
Test($state or $cursor->execute)
|
$sth->fetchrow_arrayref->[1] eq $blob,
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
'Got the blob back ok',
|
||||||
|
);
|
||||||
Test($state or (defined($row = $cursor->fetchrow_arrayref)))
|
ok( $sth->finish, '->finish' );
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob))
|
|
||||||
or (ShowBlob($blob),
|
|
||||||
ShowBlob(defined($$row[1]) ? $$row[1] : ""));
|
|
||||||
|
|
||||||
Test($state or $cursor->finish)
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
Test($state or undef $cursor || 1)
|
|
||||||
or DbiError($cursor->err, $cursor->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Finally drop the test table.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DROP TABLE $table"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -35,7 +35,7 @@ END_SQL
|
||||||
|
|
||||||
# Insert into table
|
# Insert into table
|
||||||
ok(
|
ok(
|
||||||
$dbh->do("INSERT INTO one VALUES ( 1, 'Alligator Descartes' )"),
|
$dbh->do("INSERT INTO one VALUES ( 1, 'A' )"),
|
||||||
'INSERT 1',
|
'INSERT 1',
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
|
||||||
239
t/26_commit.t
239
t/26_commit.t
|
|
@ -9,196 +9,113 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 28;
|
||||||
|
# use Test::NoWarnings;
|
||||||
|
|
||||||
use vars qw($state);
|
my $warning_count = 0;
|
||||||
|
|
||||||
#
|
|
||||||
# Include lib.pl
|
|
||||||
#
|
|
||||||
do 't/lib.pl';
|
#####################################################################
|
||||||
if ($@) {
|
# Support functions
|
||||||
print STDERR "Error while executing lib.pl: $@\n";
|
|
||||||
exit 10;
|
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",
|
||||||
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
use vars qw($gotWarning);
|
|
||||||
sub CatchWarning ($) {
|
|
||||||
$gotWarning = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub NumRows($$$) {
|
|
||||||
my($dbh, $table, $num) = @_;
|
|
||||||
my($sth, $got);
|
|
||||||
|
|
||||||
if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
|
#####################################################################
|
||||||
return "Failed to prepare: err " . $dbh->err . ", errstr "
|
# Main Tests
|
||||||
. $dbh->errstr;
|
|
||||||
}
|
|
||||||
if (!$sth->execute) {
|
|
||||||
return "Failed to execute: err " . $dbh->err . ", errstr "
|
|
||||||
. $dbh->errstr;
|
|
||||||
}
|
|
||||||
$got = 0;
|
|
||||||
while ($sth->fetchrow_arrayref) {
|
|
||||||
++$got;
|
|
||||||
}
|
|
||||||
if ($got ne $num) {
|
|
||||||
return "Wrong result: Expected $num rows, got $got.\n";
|
|
||||||
}
|
|
||||||
return '';
|
|
||||||
}
|
|
||||||
|
|
||||||
#
|
# Create a database
|
||||||
# Main loop; leave this untouched, put tests after creating
|
my $dbh = connect_ok( RaiseError => 1 );
|
||||||
# the new table.
|
|
||||||
#
|
|
||||||
my ($dbh, $def, $table, $msg);
|
|
||||||
while (Testing()) {
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
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 'DBI:SQLite:dbname=foo' references a valid database"
|
|
||||||
. " name.\nDBI error message: %s\n",
|
|
||||||
$DBI::err, $DBI::errstr);
|
|
||||||
|
|
||||||
#
|
# Create the table
|
||||||
# Find a possible new table name
|
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||||
#
|
CREATE TABLE one (
|
||||||
Test($state or $table = 'table1')
|
id INTEGER NOT NULL,
|
||||||
or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
|
name CHAR (64) NOT NULL
|
||||||
$dbh->errstr);
|
)
|
||||||
|
END_SQL
|
||||||
|
|
||||||
#
|
|
||||||
# Create a new table
|
|
||||||
#
|
|
||||||
Test($state or ($def = TableDefinition($table,
|
|
||||||
["id", "INTEGER", 4, 0],
|
|
||||||
["name", "CHAR", 64, 0]),
|
|
||||||
$dbh->do($def)))
|
|
||||||
or ErrMsgF("Cannot create table: Error %s.\n",
|
|
||||||
$dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $dbh->{AutoCommit})
|
|
||||||
or ErrMsg("AutoCommit is off\n", 'AutoCommint on');
|
|
||||||
|
|
||||||
#
|
|
||||||
# Tests for databases that do support transactions
|
|
||||||
#
|
|
||||||
if ( 1 ) {
|
|
||||||
# Turn AutoCommit off
|
# Turn AutoCommit off
|
||||||
$dbh->{AutoCommit} = 0;
|
$dbh->{AutoCommit} = 0;
|
||||||
Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
|
ok( ! $dbh->{AutoCommit}, 'AutoCommit is off' );
|
||||||
or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
|
ok( ! $dbh->err, '->err is false' );
|
||||||
$dbh->err, $dbh->errstr);
|
ok( ! $dbh->errstr, '->err is false' );
|
||||||
|
|
||||||
# Check rollback
|
# Check rollback
|
||||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
insert( $dbh );
|
||||||
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
|
rows( $dbh, 1 );
|
||||||
$dbh->err, $dbh->errstr);
|
ok( $dbh->rollback, '->rollback ok' );
|
||||||
|
rows( $dbh, 0 );
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 1)))
|
|
||||||
or ErrMsg($msg);
|
|
||||||
Test($state or $dbh->rollback)
|
|
||||||
or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
|
|
||||||
$dbh->err, $dbh->errstr);
|
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 0)))
|
|
||||||
or ErrMsg($msg);
|
|
||||||
|
|
||||||
# Check commit
|
# Check commit
|
||||||
Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
|
ok( $dbh->do('DELETE FROM one WHERE id = 1'), 'DELETE 1' );
|
||||||
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
|
rows( $dbh, 0 );
|
||||||
$dbh->err, $dbh->errstr);
|
ok( $dbh->commit, '->commit ok' );
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 0)))
|
rows( $dbh, 0 );
|
||||||
or ErrMsg($msg);
|
|
||||||
Test($state or $dbh->commit)
|
|
||||||
or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
|
|
||||||
$dbh->err, $dbh->errstr);
|
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 0)))
|
|
||||||
or ErrMsg($msg);
|
|
||||||
|
|
||||||
# Check auto rollback after disconnect
|
# Check auto rollback after disconnect
|
||||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
insert( $dbh );
|
||||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
rows( $dbh, 1 );
|
||||||
$dbh->err, $dbh->errstr);
|
ok( $dbh->disconnect, '->disconnect ok' );
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 1)))
|
$dbh = connect_ok();
|
||||||
or ErrMsg($msg);
|
rows( $dbh, 0 );
|
||||||
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("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)))
|
|
||||||
or ErrMsg($msg);
|
|
||||||
|
|
||||||
# Check whether AutoCommit is on again
|
# Check that AutoCommit is back on again after the reconnect
|
||||||
Test($state or $dbh->{AutoCommit})
|
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on' );
|
||||||
or ErrMsg("AutoCommit is off\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
# Check whether AutoCommit mode works.
|
# Check whether AutoCommit mode works.
|
||||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
insert( $dbh );
|
||||||
or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
|
rows( $dbh, 1 );
|
||||||
$dbh->err, $dbh->errstr);
|
ok( $dbh->disconnect, '->disconnect ok' );
|
||||||
Test($state or !($msg = NumRows($dbh, $table, 1)), 'NumRows')
|
$dbh = connect_ok();
|
||||||
or ErrMsg($msg);
|
rows( $dbh, 1 );
|
||||||
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("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)))
|
|
||||||
or ErrMsg($msg);
|
|
||||||
|
|
||||||
# Check whether commit issues a warning in AutoCommit mode
|
# Check whether commit issues a warning in AutoCommit mode
|
||||||
Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
|
ok( $dbh->do("INSERT INTO one VALUES ( 2, 'Tim' )"), 'INSERT 2' );
|
||||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
SCOPE: {
|
||||||
$dbh->err, $dbh->errstr);
|
local $@ = '';
|
||||||
my $result;
|
$SIG{__WARN__} = sub {
|
||||||
if (!$state) {
|
$warning_count++;
|
||||||
$@ = '';
|
};
|
||||||
$SIG{__WARN__} = \&CatchWarning;
|
eval {
|
||||||
$gotWarning = 0;
|
$dbh->commit;
|
||||||
eval { $result = $dbh->commit; };
|
};
|
||||||
$SIG{__WARN__} = 'DEFAULT';
|
$SIG{__WARN__} = 'DEFAULT';
|
||||||
|
is( $warning_count, 1, 'Got one warning' );
|
||||||
}
|
}
|
||||||
Test($state or $gotWarning)
|
|
||||||
or ErrMsg("Missing warning when committing in AutoCommit mode");
|
|
||||||
|
|
||||||
# Check whether rollback issues a warning in AutoCommit mode
|
# Check whether rollback issues a warning in AutoCommit mode
|
||||||
# We accept error messages as being legal, because the DBI
|
# We accept error messages as being legal, because the DBI
|
||||||
# requirement of just issueing a warning seems scary.
|
# requirement of just issueing a warning seems scary.
|
||||||
Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
|
ok( $dbh->do("INSERT INTO one VALUES ( 3, 'Alligator' )"), 'INSERT 3' );
|
||||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
SCOPE: {
|
||||||
$dbh->err, $dbh->errstr);
|
local $@ = '';
|
||||||
if (!$state) {
|
$SIG{__WARN__} = sub {
|
||||||
$@ = '';
|
$warning_count++;
|
||||||
$SIG{__WARN__} = \&CatchWarning;
|
};
|
||||||
$gotWarning = 0;
|
eval {
|
||||||
eval { $result = $dbh->rollback; };
|
$dbh->rollback;
|
||||||
|
};
|
||||||
$SIG{__WARN__} = 'DEFAULT';
|
$SIG{__WARN__} = 'DEFAULT';
|
||||||
}
|
is( $warning_count, 2, 'Got one warning' );
|
||||||
Test($state or $gotWarning or $dbh->err)
|
|
||||||
or ErrMsg("Missing warning when rolling back in AutoCommit mode");
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Finally drop the test table.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DROP TABLE $table"))
|
|
||||||
or ErrMsgF("Cannot DROP test table $table: %s.\n",
|
|
||||||
$dbh->errstr);
|
|
||||||
Test($state or $dbh->disconnect())
|
|
||||||
or ErrMsgF("Cannot DROP test table $table: %s.\n",
|
|
||||||
$dbh->errstr);
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
221
t/lib.pl
221
t/lib.pl
|
|
@ -1,221 +0,0 @@
|
||||||
# lib.pl is the file where database specific things should live,
|
|
||||||
# whereever possible. For example, you define certain constants
|
|
||||||
# here and the like.
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
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);
|
|
||||||
|
|
||||||
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 ;
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# The Testing() function builds the frame of the test; it can be called
|
|
||||||
# in many ways, see below.
|
|
||||||
#
|
|
||||||
# Usually there's no need for you to modify this function.
|
|
||||||
#
|
|
||||||
# Testing() (without arguments) indicates the beginning of the
|
|
||||||
# main loop; it will return, if the main loop should be
|
|
||||||
# entered (which will happen twice, once with $state = 1 and
|
|
||||||
# once with $state = 0)
|
|
||||||
# Testing('off') disables any further tests until the loop ends
|
|
||||||
# Testing('group') indicates the begin of a group of tests; you
|
|
||||||
# may use this, for example, if there's a certain test within
|
|
||||||
# the group that should make all other tests fail.
|
|
||||||
# Testing('disable') disables further tests within the group; must
|
|
||||||
# not be called without a preceding Testing('group'); by default
|
|
||||||
# tests are enabled
|
|
||||||
# Testing('enabled') reenables tests after calling Testing('disable')
|
|
||||||
# Testing('finish') terminates a group; any Testing('group') must
|
|
||||||
# be paired with Testing('finish')
|
|
||||||
#
|
|
||||||
# You may nest test groups.
|
|
||||||
#
|
|
||||||
{
|
|
||||||
# Note the use of the pairing {} in order to get local, but static,
|
|
||||||
# variables.
|
|
||||||
my (@stateStack, $count, $off);
|
|
||||||
|
|
||||||
$count = 0;
|
|
||||||
|
|
||||||
sub Testing(;$) {
|
|
||||||
my ($command) = shift;
|
|
||||||
if (!defined($command)) {
|
|
||||||
@stateStack = ();
|
|
||||||
$off = 0;
|
|
||||||
if ($count == 0) {
|
|
||||||
++$count;
|
|
||||||
$::state = 1;
|
|
||||||
} elsif ($count == 1) {
|
|
||||||
my($d);
|
|
||||||
if ($off) {
|
|
||||||
print "1..0\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
++$count;
|
|
||||||
$::state = 0;
|
|
||||||
print "1..$::numTests\n";
|
|
||||||
} else {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
if ($off) {
|
|
||||||
$::state = 1;
|
|
||||||
}
|
|
||||||
$::numTests = 0;
|
|
||||||
} elsif ($command eq 'off') {
|
|
||||||
$off = 1;
|
|
||||||
$::state = 0;
|
|
||||||
} elsif ($command eq 'group') {
|
|
||||||
push(@stateStack, $::state);
|
|
||||||
} elsif ($command eq 'disable') {
|
|
||||||
$::state = 0;
|
|
||||||
} elsif ($command eq 'enable') {
|
|
||||||
if ($off) {
|
|
||||||
$::state = 0;
|
|
||||||
} else {
|
|
||||||
my $s;
|
|
||||||
$::state = 1;
|
|
||||||
foreach $s (@stateStack) {
|
|
||||||
if (!$s) {
|
|
||||||
$::state = 0;
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return;
|
|
||||||
} elsif ($command eq 'finish') {
|
|
||||||
$::state = pop(@stateStack);
|
|
||||||
} else {
|
|
||||||
die("Testing: Unknown argument\n");
|
|
||||||
}
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Read a single test result
|
|
||||||
#
|
|
||||||
|
|
||||||
sub Test ($;$$) {
|
|
||||||
my($result, $error, $diag) = @_;
|
|
||||||
|
|
||||||
++$::numTests;
|
|
||||||
if ($count == 2) {
|
|
||||||
if (defined($diag)) {
|
|
||||||
printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n"));
|
|
||||||
}
|
|
||||||
if ($::state || $result) {
|
|
||||||
print "ok $::numTests ". (defined($error) ? "$error\n" : "\n");
|
|
||||||
return 1;
|
|
||||||
} else {
|
|
||||||
my ($pack, $file, $line) = caller();
|
|
||||||
print("not ok $::numTests at line $line - " .
|
|
||||||
(defined($error) ? "$error\n" : "\n"));
|
|
||||||
print("FAILED Test $::numTests - " .
|
|
||||||
(defined($error) ? "$error\n" : "\n"));
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Print a DBI error message
|
|
||||||
#
|
|
||||||
sub DbiError ($$) {
|
|
||||||
my($rc, $err) = @_;
|
|
||||||
$rc ||= 0;
|
|
||||||
$err ||= '';
|
|
||||||
print "Test $::numTests: DBI error $rc, $err\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ErrMsg { print (@_); }
|
|
||||||
sub ErrMsgF { printf (@_); }
|
|
||||||
|
|
||||||
1;
|
|
||||||
|
|
@ -11,115 +11,65 @@ BEGIN {
|
||||||
}
|
}
|
||||||
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 13;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
use vars qw($state);
|
# Create a database
|
||||||
|
my $dbh = connect_ok( 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
|
||||||
|
|
||||||
#
|
# Fill the table
|
||||||
# Include lib.pl
|
ok(
|
||||||
#
|
$dbh->do('INSERT INTO one values ( 1, ? )', {}, 'A'),
|
||||||
do 't/lib.pl';
|
'INSERT 1',
|
||||||
if ($@) {
|
);
|
||||||
print STDERR "Error while executing lib.pl: $@\n";
|
ok(
|
||||||
exit 10;
|
$dbh->do('INSERT INTO one values ( 2987, ? )', {}, 'Not used'),
|
||||||
|
'INSERT 1',
|
||||||
|
);
|
||||||
|
ok(
|
||||||
|
$dbh->do('INSERT INTO one values ( 2, ? )', {}, 'Gary Shea'),
|
||||||
|
'INSERT 1',
|
||||||
|
);
|
||||||
|
|
||||||
|
# Check that prepare_cached works
|
||||||
|
my $sql = "SELECT name FROM one WHERE id = ?";
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare_cached($sql);
|
||||||
|
isa_ok( $sth, 'DBI::st' );
|
||||||
|
is(
|
||||||
|
($dbh->selectrow_array($sth, undef, 1))[0],
|
||||||
|
'A',
|
||||||
|
'Query 1 Row 1',
|
||||||
|
);
|
||||||
}
|
}
|
||||||
|
SCOPE: {
|
||||||
sub ServerError() {
|
my $sth = $dbh->prepare_cached($sql);
|
||||||
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
|
isa_ok( $sth, 'DBI::st' );
|
||||||
"\tEither your server is not up and running or you have no\n",
|
is(
|
||||||
"\tpermissions for acessing the DSN DBI:SQLite:dbname=foo.\n",
|
($dbh->selectrow_array($sth, undef, 1))[0],
|
||||||
"\tThis test requires a running server and write permissions.\n",
|
'A',
|
||||||
"\tPlease make sure your server is running and you have\n",
|
'Query 2 Row 1',
|
||||||
"\tpermissions, then retry.\n");
|
);
|
||||||
exit 10;
|
is(
|
||||||
|
($dbh->selectrow_array($sth, undef, 2))[0],
|
||||||
|
'Gary Shea',
|
||||||
|
'Query 2 Row 2',
|
||||||
|
);
|
||||||
}
|
}
|
||||||
|
SCOPE: {
|
||||||
|
my $sth = $dbh->prepare_cached($sql);
|
||||||
sub TrueRows($) {
|
isa_ok( $sth, 'DBI::st' );
|
||||||
my ($sth) = @_;
|
is(
|
||||||
my $count = 0;
|
($dbh->selectrow_array($sth, undef, 2))[0],
|
||||||
while ($sth->fetchrow_arrayref) {
|
'Gary Shea',
|
||||||
++$count;
|
'Query 2 Row 2',
|
||||||
|
);
|
||||||
}
|
}
|
||||||
$count;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# Main loop; leave this untouched, put tests after creating
|
|
||||||
# the new table.
|
|
||||||
#
|
|
||||||
my ($dbh, $table, $def, $cursor, $sth);
|
|
||||||
while (Testing()) {
|
|
||||||
#
|
|
||||||
# Connect to the database
|
|
||||||
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
|
|
||||||
'')))
|
|
||||||
or ServerError();
|
|
||||||
|
|
||||||
#
|
|
||||||
# Find a possible new table name
|
|
||||||
#
|
|
||||||
Test($state or $table = 'table1')
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Create a new table; EDIT THIS!
|
|
||||||
#
|
|
||||||
Test($state or ($def = TableDefinition($table,
|
|
||||||
["id", "INTEGER", 4, 0],
|
|
||||||
["name", "CHAR", 64, 0]),
|
|
||||||
$dbh->do($def)))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
|
|
||||||
#
|
|
||||||
# This section should exercise the sth->rows
|
|
||||||
# method by preparing a statement, then finding the
|
|
||||||
# number of rows within it.
|
|
||||||
# Prior to execution, this should fail. After execution, the
|
|
||||||
# number of rows affected by the statement will be returned.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("INSERT INTO $table"
|
|
||||||
. " VALUES( 1, 'Alligator Descartes' )"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $dbh->do("INSERT INTO $table"
|
|
||||||
. " VALUES( 2987, 'Not used' )"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $dbh->do("INSERT INTO $table"
|
|
||||||
. " VALUES( 2, 'Gary Shea' )"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
my $test_query = "SELECT name FROM $table WHERE id = ?";
|
|
||||||
|
|
||||||
Test($state or $sth = $dbh->prepare_cached($test_query))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or (($dbh->selectrow_array($sth, undef, 1))[0] eq "Alligator Descartes"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $sth = $dbh->prepare_cached($test_query))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or (($dbh->selectrow_array($sth, undef, 1))[0] eq "Alligator Descartes"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or (($dbh->selectrow_array($sth, undef, 2))[0] eq "Gary Shea"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or $sth = $dbh->prepare_cached($test_query))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
Test($state or (($dbh->selectrow_array($sth, undef, 2))[0] eq "Gary Shea"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
#
|
|
||||||
# Finally drop the test table.
|
|
||||||
#
|
|
||||||
Test($state or $dbh->do("DROP TABLE $table"))
|
|
||||||
or DbiError($dbh->err, $dbh->errstr);
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 13;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 14;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
# Create the table
|
# Create the table
|
||||||
my $dbh = connect_ok();
|
my $dbh = connect_ok();
|
||||||
|
|
|
||||||
|
|
@ -10,11 +10,13 @@ use t::lib::Test;
|
||||||
use Test::More;
|
use Test::More;
|
||||||
BEGIN {
|
BEGIN {
|
||||||
if ( $] >= 5.008005 ) {
|
if ( $] >= 5.008005 ) {
|
||||||
plan( tests => 14 );
|
plan( tests => 15 );
|
||||||
} else {
|
} else {
|
||||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
eval "require utf8";
|
eval "require utf8";
|
||||||
die $@ if $@;
|
die $@ if $@;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -5,8 +5,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 5;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 6;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 );
|
my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 );
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 16;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 17;
|
||||||
|
use Test::NoWarnings;
|
||||||
use DBI qw(:sql_types);
|
use DBI qw(:sql_types);
|
||||||
|
|
||||||
my $dbh = connect_ok();
|
my $dbh = connect_ok();
|
||||||
|
|
|
||||||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 7;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 8;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
my $dbh = connect_ok( RaiseError => 1 );
|
my $dbh = connect_ok( RaiseError => 1 );
|
||||||
$dbh->do("CREATE TABLE f (f1, f2, f3)");
|
$dbh->do("CREATE TABLE f (f1, f2, f3)");
|
||||||
|
|
|
||||||
|
|
@ -10,8 +10,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 31;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 32;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
# Create the table
|
# Create the table
|
||||||
SCOPE: {
|
SCOPE: {
|
||||||
|
|
|
||||||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
||||||
$^W = 1;
|
$^W = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
use Test::More tests => 3;
|
|
||||||
use t::lib::Test;
|
use t::lib::Test;
|
||||||
|
use Test::More tests => 4;
|
||||||
|
use Test::NoWarnings;
|
||||||
|
|
||||||
my $dbh = connect_ok( RaiseError => 1, PrintError => 0 );
|
my $dbh = connect_ok( RaiseError => 1, PrintError => 0 );
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue