mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -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.
|
||||
|
||||
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
|
||||
on Windows (SZABGAB/ISHIGAKI)
|
||||
- Removed the table name generator from t/lib.pl,
|
||||
|
|
|
|||
321
t/15_ak_dbd.t
321
t/15_ak_dbd.t
|
|
@ -7,219 +7,132 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 37;
|
||||
use Test::NoWarnings;
|
||||
|
||||
#
|
||||
# Make -w happy
|
||||
#
|
||||
use vars qw($state);
|
||||
use vars qw($COL_NULLABLE $COL_KEY);
|
||||
# Create a database
|
||||
my $dbh = connect_ok( RaiseError => 1, PrintError => 1, PrintWarn => 1 );
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
require "t/lib.pl";
|
||||
# Create the table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NOT NULL,
|
||||
name CHAR (64)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
#
|
||||
# Main loop; leave this untouched, put tests after creating
|
||||
# the new table.
|
||||
#
|
||||
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");
|
||||
# Test quoting
|
||||
my $quoted = $dbh->quote('test1');
|
||||
is( $quoted, "'test1'", '->quote(test1) ok' );
|
||||
|
||||
#
|
||||
# Find a possible new table name
|
||||
#
|
||||
Test($state or $test_table = 'table1') or 1
|
||||
or ErrMsg("Cannot get table name: $dbh->errstr.\n");
|
||||
# Disconnect
|
||||
ok( $dbh->disconnect, '->disconnect' );
|
||||
|
||||
#
|
||||
# Create a new table; EDIT THIS!
|
||||
#
|
||||
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");
|
||||
# Reconnect
|
||||
$dbh = connect_ok();
|
||||
|
||||
#
|
||||
# and here's the right place for inserting new tests:
|
||||
#
|
||||
Test($state or $dbh->quote('tast1'))
|
||||
or ErrMsgF("quote('tast1') returned %s.\n", $dbh->quote('tast1'));
|
||||
# Delete the table and recreate it
|
||||
ok( $dbh->do('DROP TABLE one'), 'DROP' );
|
||||
|
||||
### ...and disconnect
|
||||
Test($state or $dbh->disconnect)
|
||||
or ErrMsg("\$dbh->disconnect() failed!\n",
|
||||
"Make sure your server is still functioning",
|
||||
"correctly, and check to make\n",
|
||||
"sure your network isn\'t malfunctioning in the",
|
||||
"case of the server running on a remote machine.\n");
|
||||
# Create the table again
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NULL,
|
||||
name CHAR (64) NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
### Now, re-connect again so that we can do some more complicated stuff..
|
||||
Test($state or ($dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '')))
|
||||
or ErrMsg("reconnect failed: $DBI::errstr\n");
|
||||
# Insert into table
|
||||
ok( $dbh->do("INSERT INTO one VALUES ( 1, 'A' )"), 'INSERT 1' );
|
||||
|
||||
Test($state or $dbh->do("DROP TABLE $test_table"))
|
||||
or ErrMsg("Dropping table failed: $dbh->errstr.\n");
|
||||
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");
|
||||
# Delete it
|
||||
ok( $dbh->do('DELETE FROM one WHERE id = 1'), 'DELETE 1' );
|
||||
|
||||
### Insert a row into the test table.......
|
||||
print "Inserting a row...\n";
|
||||
Test($state or ($dbh->do("INSERT INTO $test_table VALUES(1,"
|
||||
. " 'Alligator Descartes')")))
|
||||
or ErrMsg("INSERT failed: $dbh->errstr.\n");
|
||||
|
||||
### ...and delete it........
|
||||
print "Deleting a row...\n";
|
||||
Test($state or $dbh->do("DELETE FROM $test_table WHERE id = 1"))
|
||||
or ErrMsg("Cannot delete row: $dbh->errstr.\n");
|
||||
Test($state or ($sth = $dbh->prepare("SELECT * FROM $test_table"
|
||||
. " 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.
|
||||
my(@row, $ref);
|
||||
{
|
||||
local($^W) = 0;
|
||||
Test($state or !defined($ref = $sth->fetch))
|
||||
or ErrMsgF("Unexpected row returned by fetchrow: $ref\n".
|
||||
scalar(@row));
|
||||
}
|
||||
|
||||
# Now try a "finish"
|
||||
Test($state or $sth->finish)
|
||||
or ErrMsg("sth->finish failed: $sth->errstr.\n");
|
||||
|
||||
# Call destructors:
|
||||
Test($state or (undef $sth || 1));
|
||||
|
||||
### This section should exercise the sth->func( '_NumRows' ) private
|
||||
### 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($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
|
||||
### as undef, or something much more bizarre
|
||||
$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 id IS NULL";
|
||||
Test($state or ($sth = $dbh->prepare($query)))
|
||||
or ErrMsgF("Cannot prepare, query = $query, error %s.\n",
|
||||
$dbh->errstr);
|
||||
if (!$state) {
|
||||
print "Test 25: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
|
||||
}
|
||||
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
|
||||
$query = "DELETE FROM $test_table WHERE id = NULL AND"
|
||||
. " 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");
|
||||
# When we "forget" execute, fail with error message
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
my ($pe) = $sth->{PrintError};
|
||||
$sth->{PrintError} = 0;
|
||||
my $rv = eval {
|
||||
$sth->fetchrow;
|
||||
};
|
||||
$sth->{PrintError} = $pe;
|
||||
ok( $sth->execute, '->execute' );
|
||||
|
||||
# This should fail without error message: No rows returned.
|
||||
my(@row, $ref);
|
||||
SCOPE: {
|
||||
local $^W = 0;
|
||||
is( $sth->fetch, undef, '->fetch returns undef' );
|
||||
}
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
# This section should exercise the sth->func( '_NumRows' ) private
|
||||
# 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.
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
is( $sth->rows, -1, '->rows is negative' );
|
||||
ok( $sth->execute, '->execute ok' );
|
||||
is( $sth->rows, 0, '->rows returns 0' );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
# Test whether or not a field containing a NULL is returned correctly
|
||||
# as undef, or something much more bizarre
|
||||
ok( $dbh->do("INSERT INTO one VALUES ( NULL, 'NULL-valued id' )"), 'INSERT 2' );
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare("SELECT id FROM one WHERE id IS NULL");
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
is_deeply(
|
||||
$sth->fetchall_arrayref,
|
||||
[ [ undef ] ],
|
||||
'NULL returned ok',
|
||||
);
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
# Delete the test row from the table
|
||||
ok( $dbh->do("DELETE FROM one WHERE id is NULL AND name = 'NULL-valued id'"), 'DELETE' );
|
||||
|
||||
# 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 Test::More tests => 10;
|
||||
use Test::NoWarnings;
|
||||
|
||||
use vars qw($state);
|
||||
|
||||
#
|
||||
# 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 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
|
||||
|
||||
# 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' );
|
||||
}
|
||||
|
|
|
|||
234
t/19_bindparam.t
234
t/19_bindparam.t
|
|
@ -7,178 +7,72 @@ BEGIN {
|
|||
}
|
||||
|
||||
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 );
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
use vars qw($COL_NULLABLE);
|
||||
do 't/lib.pl';
|
||||
if ($@) {
|
||||
print STDERR "Error while executing lib.pl: $@\n";
|
||||
exit 10;
|
||||
# Create the table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NOT NULL,
|
||||
name CHAR (64) NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
my $konig = "Andreas K\xf6nig";
|
||||
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare("INSERT INTO one VALUES ( ?, ? )");
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
|
||||
# Automatic type detection
|
||||
my $number = 1;
|
||||
my $char = "A";
|
||||
ok( $sth->execute($number, $char), 'EXECUTE 1' );
|
||||
|
||||
# Does the driver remember the automatically detected type?
|
||||
ok( $sth->execute("3", "Jochen Wiedmann"), 'EXECUTE 2' );
|
||||
$number = 2;
|
||||
$char = "Tim Bunce";
|
||||
ok( $sth->execute($number, $char), 'EXECUTE 3');
|
||||
|
||||
# Now try the explicit type settings
|
||||
ok( $sth->bind_param(1, " 4", SQL_INTEGER), 'bind 1' );
|
||||
ok( $sth->bind_param(2, $konig), 'bind 2' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
|
||||
# Works undef -> NULL?
|
||||
ok( $sth->bind_param(1, 5, SQL_INTEGER), 'bind 3' );
|
||||
ok( $sth->bind_param(2, undef), 'bind 4' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
}
|
||||
|
||||
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;
|
||||
# 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' );
|
||||
}
|
||||
|
||||
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";
|
||||
# warn("Konig: $konig\n");
|
||||
|
||||
# Automatic type detection
|
||||
my $numericVal = 1;
|
||||
my $charVal = "Alligator Descartes";
|
||||
Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 1')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
# Does the driver remember the automatically detected type?
|
||||
Test($state or $cursor->execute("3", "Jochen Wiedmann"),
|
||||
'execute insert num as string')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
$numericVal = 2;
|
||||
$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
|
||||
Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()), 'bind 1')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
Test($state or $cursor->bind_param(2, $konig), 'bind 2')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
Test($state or $cursor->execute, 'execute binds')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
# Works undef -> NULL?
|
||||
Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
Test($state or $cursor->bind_param(2, undef))
|
||||
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);
|
||||
}
|
||||
|
||||
|
|
|
|||
164
t/20_blobs.t
164
t/20_blobs.t
|
|
@ -10,33 +10,9 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
|
||||
use vars qw($state);
|
||||
|
||||
|
||||
#
|
||||
# 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;
|
||||
}
|
||||
|
||||
use Test::More tests => 10;
|
||||
use Test::NoWarnings;
|
||||
use DBI ':sql_types';
|
||||
|
||||
sub ShowBlob($) {
|
||||
my ($blob) = @_;
|
||||
|
|
@ -58,102 +34,44 @@ sub ShowBlob($) {
|
|||
if ($ENV{SHOW_BLOBS}) { close(OUT) }
|
||||
}
|
||||
|
||||
# Create a database
|
||||
my $dbh = connect_ok();
|
||||
$dbh->{sqlite_handle_binary_nulls} = 1;
|
||||
|
||||
#
|
||||
# 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();
|
||||
# Create the table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NOT NULL,
|
||||
name BLOB (128) NOT NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
|
||||
$dbh->{sqlite_handle_binary_nulls} = 1;
|
||||
|
||||
#
|
||||
# Find a possible new table name
|
||||
#
|
||||
Test($state or $table = 'table1')
|
||||
or DbiError($dbh->error, $dbh->errstr);
|
||||
|
||||
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
|
||||
#
|
||||
my ($blob, $qblob) = "";
|
||||
if (!$state) {
|
||||
my $b = "";
|
||||
for (my $j = 0; $j < 256; $j++) {
|
||||
$b .= chr($j);
|
||||
}
|
||||
for (my $i = 0; $i < $size; $i++) {
|
||||
$blob .= $b;
|
||||
}
|
||||
$qblob = $dbh->quote($blob);
|
||||
}
|
||||
|
||||
#
|
||||
# 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.
|
||||
#
|
||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
|
||||
. " WHERE id = 1"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor->execute)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or (defined($row = $cursor->fetchrow_arrayref)))
|
||||
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);
|
||||
}
|
||||
# Create a blob
|
||||
my $blob = '';
|
||||
my $b = '';
|
||||
for ( my $j = 0; $j < 256; $j++ ) {
|
||||
$b .= chr($j);
|
||||
}
|
||||
for ( my $i = 0; $i < 128; $i++ ) {
|
||||
$blob .= $b;
|
||||
}
|
||||
|
||||
# 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' );
|
||||
}
|
||||
|
||||
# Now, try SELECT'ing the row out.
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare("SELECT * FROM one WHERE id = 1");
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
ok(
|
||||
$sth->fetchrow_arrayref->[1] eq $blob,
|
||||
'Got the blob back ok',
|
||||
);
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ END_SQL
|
|||
|
||||
# Insert into table
|
||||
ok(
|
||||
$dbh->do("INSERT INTO one VALUES ( 1, 'Alligator Descartes' )"),
|
||||
$dbh->do("INSERT INTO one VALUES ( 1, 'A' )"),
|
||||
'INSERT 1',
|
||||
);
|
||||
|
||||
|
|
|
|||
265
t/26_commit.t
265
t/26_commit.t
|
|
@ -9,196 +9,113 @@ BEGIN {
|
|||
}
|
||||
|
||||
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 ($@) {
|
||||
print STDERR "Error while executing lib.pl: $@\n";
|
||||
exit 10;
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Support functions
|
||||
|
||||
sub insert {
|
||||
Test::More::ok(
|
||||
$_[0]->do("INSERT INTO one VALUES (1, 'Jochen')"),
|
||||
'INSERT 1',
|
||||
);
|
||||
}
|
||||
|
||||
sub rows {
|
||||
my $dbh = shift;
|
||||
my $expected = shift;
|
||||
is_deeply(
|
||||
$dbh->selectall_arrayref('select count(*) from one'),
|
||||
[ [ $expected ] ],
|
||||
"Found $expected rows",
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
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 "
|
||||
. $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 '';
|
||||
}
|
||||
#####################################################################
|
||||
# Main Tests
|
||||
|
||||
#
|
||||
# Main loop; leave this untouched, put tests after creating
|
||||
# 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 a database
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
|
||||
#
|
||||
# Find a possible new table name
|
||||
#
|
||||
Test($state or $table = 'table1')
|
||||
or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
|
||||
$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
|
||||
|
||||
#
|
||||
# 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);
|
||||
# Turn AutoCommit off
|
||||
$dbh->{AutoCommit} = 0;
|
||||
ok( ! $dbh->{AutoCommit}, 'AutoCommit is off' );
|
||||
ok( ! $dbh->err, '->err is false' );
|
||||
ok( ! $dbh->errstr, '->err is false' );
|
||||
|
||||
Test($state or $dbh->{AutoCommit})
|
||||
or ErrMsg("AutoCommit is off\n", 'AutoCommint on');
|
||||
# Check rollback
|
||||
insert( $dbh );
|
||||
rows( $dbh, 1 );
|
||||
ok( $dbh->rollback, '->rollback ok' );
|
||||
rows( $dbh, 0 );
|
||||
|
||||
#
|
||||
# Tests for databases that do support transactions
|
||||
#
|
||||
if ( 1 ) {
|
||||
# Turn AutoCommit off
|
||||
$dbh->{AutoCommit} = 0;
|
||||
Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
|
||||
or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
# Check commit
|
||||
ok( $dbh->do('DELETE FROM one WHERE id = 1'), 'DELETE 1' );
|
||||
rows( $dbh, 0 );
|
||||
ok( $dbh->commit, '->commit ok' );
|
||||
rows( $dbh, 0 );
|
||||
|
||||
# Check rollback
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
||||
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
# Check auto rollback after disconnect
|
||||
insert( $dbh );
|
||||
rows( $dbh, 1 );
|
||||
ok( $dbh->disconnect, '->disconnect ok' );
|
||||
$dbh = connect_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 that AutoCommit is back on again after the reconnect
|
||||
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on' );
|
||||
|
||||
# Check commit
|
||||
Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
|
||||
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
Test($state or !($msg = NumRows($dbh, $table, 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 whether AutoCommit mode works.
|
||||
insert( $dbh );
|
||||
rows( $dbh, 1 );
|
||||
ok( $dbh->disconnect, '->disconnect ok' );
|
||||
$dbh = connect_ok();
|
||||
rows( $dbh, 1 );
|
||||
|
||||
# Check auto rollback after disconnect
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
Test($state or !($msg = NumRows($dbh, $table, 1)))
|
||||
or ErrMsg($msg);
|
||||
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
|
||||
Test($state or $dbh->{AutoCommit})
|
||||
or ErrMsg("AutoCommit is off\n");
|
||||
}
|
||||
|
||||
# Check whether AutoCommit mode works.
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
|
||||
or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
Test($state or !($msg = NumRows($dbh, $table, 1)), 'NumRows')
|
||||
or ErrMsg($msg);
|
||||
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
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
|
||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
my $result;
|
||||
if (!$state) {
|
||||
$@ = '';
|
||||
$SIG{__WARN__} = \&CatchWarning;
|
||||
$gotWarning = 0;
|
||||
eval { $result = $dbh->commit; };
|
||||
# Check whether commit issues a warning in AutoCommit mode
|
||||
ok( $dbh->do("INSERT INTO one VALUES ( 2, 'Tim' )"), 'INSERT 2' );
|
||||
SCOPE: {
|
||||
local $@ = '';
|
||||
$SIG{__WARN__} = sub {
|
||||
$warning_count++;
|
||||
};
|
||||
eval {
|
||||
$dbh->commit;
|
||||
};
|
||||
$SIG{__WARN__} = 'DEFAULT';
|
||||
}
|
||||
Test($state or $gotWarning)
|
||||
or ErrMsg("Missing warning when committing in AutoCommit mode");
|
||||
|
||||
# Check whether rollback issues a warning in AutoCommit mode
|
||||
# We accept error messages as being legal, because the DBI
|
||||
# requirement of just issueing a warning seems scary.
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
|
||||
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
|
||||
$dbh->err, $dbh->errstr);
|
||||
if (!$state) {
|
||||
$@ = '';
|
||||
$SIG{__WARN__} = \&CatchWarning;
|
||||
$gotWarning = 0;
|
||||
eval { $result = $dbh->rollback; };
|
||||
$SIG{__WARN__} = 'DEFAULT';
|
||||
}
|
||||
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);
|
||||
is( $warning_count, 1, 'Got one warning' );
|
||||
}
|
||||
|
||||
# Check whether rollback issues a warning in AutoCommit mode
|
||||
# We accept error messages as being legal, because the DBI
|
||||
# requirement of just issueing a warning seems scary.
|
||||
ok( $dbh->do("INSERT INTO one VALUES ( 3, 'Alligator' )"), 'INSERT 3' );
|
||||
SCOPE: {
|
||||
local $@ = '';
|
||||
$SIG{__WARN__} = sub {
|
||||
$warning_count++;
|
||||
};
|
||||
eval {
|
||||
$dbh->rollback;
|
||||
};
|
||||
$SIG{__WARN__} = 'DEFAULT';
|
||||
is( $warning_count, 2, 'Got one warning' );
|
||||
}
|
||||
|
|
|
|||
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 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
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
do 't/lib.pl';
|
||||
if ($@) {
|
||||
print STDERR "Error while executing lib.pl: $@\n";
|
||||
exit 10;
|
||||
# Fill the table
|
||||
ok(
|
||||
$dbh->do('INSERT INTO one values ( 1, ? )', {}, 'A'),
|
||||
'INSERT 1',
|
||||
);
|
||||
ok(
|
||||
$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',
|
||||
);
|
||||
}
|
||||
|
||||
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;
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
is(
|
||||
($dbh->selectrow_array($sth, undef, 1))[0],
|
||||
'A',
|
||||
'Query 2 Row 1',
|
||||
);
|
||||
is(
|
||||
($dbh->selectrow_array($sth, undef, 2))[0],
|
||||
'Gary Shea',
|
||||
'Query 2 Row 2',
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub TrueRows($) {
|
||||
my ($sth) = @_;
|
||||
my $count = 0;
|
||||
while ($sth->fetchrow_arrayref) {
|
||||
++$count;
|
||||
}
|
||||
$count;
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
is(
|
||||
($dbh->selectrow_array($sth, undef, 2))[0],
|
||||
'Gary Shea',
|
||||
'Query 2 Row 2',
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# 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;
|
||||
}
|
||||
|
||||
use Test::More tests => 13;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 14;
|
||||
use Test::NoWarnings;
|
||||
|
||||
# Create the table
|
||||
my $dbh = connect_ok();
|
||||
|
|
|
|||
|
|
@ -10,11 +10,13 @@ use t::lib::Test;
|
|||
use Test::More;
|
||||
BEGIN {
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 14 );
|
||||
plan( tests => 15 );
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
}
|
||||
use Test::NoWarnings;
|
||||
|
||||
eval "require utf8";
|
||||
die $@ if $@;
|
||||
|
||||
|
|
|
|||
|
|
@ -5,8 +5,9 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 5;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 6;
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 );
|
||||
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 16;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 17;
|
||||
use Test::NoWarnings;
|
||||
use DBI qw(:sql_types);
|
||||
|
||||
my $dbh = connect_ok();
|
||||
|
|
@ -20,12 +21,12 @@ create table artist (
|
|||
)
|
||||
END_SQL
|
||||
|
||||
ok ( $dbh->do(q/insert into artist (id,name) values(1, 'Leonardo da Vinci')/), 'insert');
|
||||
ok( $dbh->do(q/insert into artist (id,name) values(1, 'Leonardo da Vinci')/), 'insert');
|
||||
|
||||
# length works in a select list...
|
||||
my $sth = $dbh->prepare('select length(name) from artist where id=?');
|
||||
ok ( $sth->execute(1), 'execute, select length' );
|
||||
is ( $sth->fetchrow_arrayref->[0], 17, 'select length result' );
|
||||
ok( $sth->execute(1), 'execute, select length' );
|
||||
is( $sth->fetchrow_arrayref->[0], 17, 'select length result' );
|
||||
|
||||
# but not in a where clause...
|
||||
my $statement = 'select count(*) from artist where length(name) > ?';
|
||||
|
|
@ -34,47 +35,47 @@ my $statement = 'select count(*) from artist where length(name) > ?';
|
|||
TODO: {
|
||||
local $TODO = 'This test is currently broken again. Wait for a better fix, or use known workarounds.';
|
||||
$sth = $dbh->prepare($statement);
|
||||
ok ( $sth->execute(2), "execute: $statement : [2]" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
ok( $sth->execute(2), "execute: $statement : [2]" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
}
|
||||
|
||||
# ...works without bind args, though!
|
||||
$statement =~ s/\?/2/;
|
||||
$sth = $dbh->prepare($statement);
|
||||
ok ( $sth->execute, "execute: $statement" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement" );
|
||||
ok( $sth->execute, "execute: $statement" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement" );
|
||||
|
||||
### it does work, however, from the sqlite3 CLI...
|
||||
# require Shell;
|
||||
# $Shell::raw = 1;
|
||||
# is ( sqlite3($db, "'$statement;'"), "1\n", 'sqlite3 CLI' );
|
||||
# is( sqlite3($db, "'$statement;'"), "1\n", 'sqlite3 CLI' );
|
||||
|
||||
# (Jess Robinson discovered that it passes with an arg of 1)
|
||||
$statement =~ s/2/1/;
|
||||
$sth = $dbh->prepare($statement);
|
||||
ok ( $sth->execute, "execute: $statement" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement" );
|
||||
ok( $sth->execute, "execute: $statement" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement" );
|
||||
|
||||
# (...but still not with bind args)
|
||||
TODO: {
|
||||
local $TODO = 'This test is currently broken again. Wait for a better fix, or use known workarounds.';
|
||||
$statement =~ s/1/?/;
|
||||
$sth = $dbh->prepare($statement);
|
||||
ok ( $sth->execute(1), "execute: $statement : [1]" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement [1]" );
|
||||
ok( $sth->execute(1), "execute: $statement : [1]" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement [1]" );
|
||||
}
|
||||
|
||||
# known workarounds 1: use bind_param explicitly
|
||||
|
||||
$sth = $dbh->prepare($statement);
|
||||
$sth->bind_param(1, 2, { TYPE => SQL_INTEGER });
|
||||
ok ( $sth->execute, "execute: $statement : [2]" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
ok( $sth->execute, "execute: $statement : [2]" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
|
||||
# known workarounds 2: add "+0" to let sqlite convert the binded param into number
|
||||
|
||||
$statement =~ s/\?/\?\+0/;
|
||||
$sth = $dbh->prepare($statement);
|
||||
ok ( $sth->execute(2), "execute: $statement : [2]" );
|
||||
is ( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
ok( $sth->execute(2), "execute: $statement : [2]" );
|
||||
is( $sth->fetchrow_arrayref->[0], 1, "result of: $statement : [2]" );
|
||||
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 7;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 8;
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1 );
|
||||
$dbh->do("CREATE TABLE f (f1, f2, f3)");
|
||||
|
|
|
|||
|
|
@ -10,8 +10,9 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 31;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 32;
|
||||
use Test::NoWarnings;
|
||||
|
||||
# Create the table
|
||||
SCOPE: {
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 3;
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 4;
|
||||
use Test::NoWarnings;
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1, PrintError => 0 );
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue