mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
Converted another batch of tests from lib.pl to t::lib::Test
This commit is contained in:
Adam Kennedy
parent
54682e35e1
commit
e991a7db97
10 changed files with 188 additions and 469 deletions
6
Changes
6
Changes
|
|
@ -1,7 +1,11 @@
|
|||
Changes for Perl extension DBD-SQLite.
|
||||
|
||||
1.22_07 not yet released
|
||||
- Improved non-latin unicode filename support/test on Windows (SZABGAB/ISHIGAKI)
|
||||
- Improved non-latin unicode filename support/test
|
||||
on Windows (SZABGAB/ISHIGAKI)
|
||||
- Removed the table name generator from t/lib.pl,
|
||||
getting us closer to removing t/lib.pl entirely (ADAMK)
|
||||
- Increased use of Test::NoWarnings (ADAMK)
|
||||
|
||||
1.22_06 Wed 15 Apr 2009
|
||||
- Simplifying various miscellaneous code (ADAMK)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ use DynaLoader ();
|
|||
use vars qw($VERSION @ISA);
|
||||
use vars qw{$err $errstr $drh $sqlite_version};
|
||||
BEGIN {
|
||||
$VERSION = '1.22_06';
|
||||
$VERSION = '1.22_07';
|
||||
@ISA = ('DynaLoader');
|
||||
|
||||
# Initialize errors
|
||||
|
|
@ -65,7 +65,7 @@ sub connect {
|
|||
|
||||
# To avoid unicode and long file name problems on Windows,
|
||||
# convert to the shortname if the file (or parent directory) exists.
|
||||
if ( $^O eq 'MSWin32' and $real ne ':memory:') {
|
||||
if ( $^O eq 'MSWin32' and $real ne ':memory:' ) {
|
||||
require Win32;
|
||||
require File::Basename;
|
||||
my ($file, $dir, $suffix) = File::Basename::fileparse($real);
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 15;
|
||||
use Test::More tests => 16;
|
||||
use Test::NoWarnings;
|
||||
|
||||
# Create the aggregate test packages
|
||||
|
|
|
|||
|
|
@ -10,67 +10,19 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 4;
|
||||
use Test::NoWarnings;
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
do 't/lib.pl';
|
||||
if ($@) {
|
||||
print STDERR "Error while executing lib.pl: $@\n";
|
||||
exit 10;
|
||||
}
|
||||
# Create a database
|
||||
my $dbh = connect_ok();
|
||||
|
||||
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;
|
||||
}
|
||||
# Create a table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NOT NULL,
|
||||
name CHAR (64) NOT NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
#
|
||||
# Main loop; leave this untouched, put tests into the loop
|
||||
#
|
||||
use vars qw($state);
|
||||
while (Testing()) {
|
||||
#
|
||||
# Connect to the database
|
||||
my $dbh;
|
||||
Test($state or $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', ''))
|
||||
or ServerError();
|
||||
|
||||
#
|
||||
# Find a possible new table name
|
||||
#
|
||||
my $table;
|
||||
Test($state or $table = 'table1')
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
#
|
||||
# Create a new table
|
||||
#
|
||||
my $def;
|
||||
if (!$state) {
|
||||
($def = TableDefinition($table,
|
||||
["id", "INTEGER", 4, 0],
|
||||
["name", "CHAR", 64, 0]));
|
||||
print "Creating table:\n$def\n";
|
||||
}
|
||||
Test($state or $dbh->do($def))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
|
||||
#
|
||||
# ... and drop it.
|
||||
#
|
||||
Test($state or $dbh->do("DROP TABLE $table"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
#
|
||||
# Finally disconnect.
|
||||
#
|
||||
Test($state or $dbh->disconnect())
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
}
|
||||
# Drop the table
|
||||
ok( $dbh->do('DROP TABLE one'), 'DROP TABLE' );
|
||||
|
|
|
|||
|
|
@ -9,89 +9,39 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 12;
|
||||
use Test::NoWarnings;
|
||||
|
||||
use vars qw($state $COL_KEY $COL_NULLABLE);
|
||||
# Create a database
|
||||
my $dbh = connect_ok();
|
||||
|
||||
$COL_KEY = '';
|
||||
# Create the table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER NOT NULL,
|
||||
name CHAR (64)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
SCOPE: {
|
||||
# Create the statement
|
||||
my $sth = $dbh->prepare('SELECT * from one');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
do 't/lib.pl';
|
||||
if ($@) {
|
||||
print STDERR "Error while executing lib.pl: $@\n";
|
||||
exit 10;
|
||||
# Execute the statement
|
||||
ok( $sth->execute, '->execute' );
|
||||
|
||||
# Check the field metadata
|
||||
is( $sth->{NUM_OF_FIELDS}, 2, 'Found 2 fields' );
|
||||
is_deeply( $sth->{NAME}, [ 'id', 'name' ], 'Names are ok' );
|
||||
ok( $sth->finish, '->finish ok' );
|
||||
}
|
||||
|
||||
|
||||
my @table_def = (
|
||||
["id", "INTEGER", 4, $COL_KEY],
|
||||
["name", "CHAR", 64, $COL_NULLABLE]
|
||||
);
|
||||
|
||||
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, $table, $def, $cursor, $ref);
|
||||
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
|
||||
#
|
||||
Test($state or ($def = TableDefinition($table, @table_def),
|
||||
$dbh->do($def)))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
|
||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor->execute)
|
||||
or DbiError($cursor->err, $cursor->errstr);
|
||||
|
||||
my $res;
|
||||
Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
|
||||
or DbiError($cursor->err, $cursor->errstr);
|
||||
|
||||
Test($state or ($ref = $cursor->{'NAME'}) && @$ref == @table_def
|
||||
&& (lc $$ref[0]) eq $table_def[0][0]
|
||||
&& (lc $$ref[1]) eq $table_def[1][0])
|
||||
or DbiError($cursor->err, $cursor->errstr);
|
||||
|
||||
Test($state or undef $cursor || 1);
|
||||
|
||||
|
||||
#
|
||||
# Drop the test table
|
||||
#
|
||||
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
Test($state or $cursor->execute)
|
||||
or DbiError($cursor->err, $cursor->errstr);
|
||||
|
||||
# NUM_OF_FIELDS should be zero (Non-Select)
|
||||
Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0));
|
||||
Test($state or (undef $cursor) or 1);
|
||||
SCOPE: {
|
||||
# Check field metadata on a drop statement
|
||||
my $sth = $dbh->prepare('DROP TABLE one');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
is( $sth->{NUM_OF_FIELDS}, 0, 'No fields in statement' );
|
||||
ok( $sth->finish, '->finish ok' );
|
||||
}
|
||||
|
|
|
|||
107
t/23_nulls.t
107
t/23_nulls.t
|
|
@ -9,88 +9,33 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 9;
|
||||
|
||||
use vars qw($state);
|
||||
# Create a database
|
||||
my $dbh = connect_ok();
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
use DBI;
|
||||
use vars qw($COL_NULLABLE);
|
||||
|
||||
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, $table, $def, $cursor, $rv);
|
||||
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, $COL_NULLABLE],
|
||||
["name", "CHAR", 64, 0]),
|
||||
$dbh->do($def)))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
|
||||
#
|
||||
# Test whether or not a field containing a NULL is returned correctly
|
||||
# as undef, or something much more bizarre
|
||||
#
|
||||
Test($state or $dbh->do("INSERT INTO $table VALUES"
|
||||
. " ( NULL, 'NULL-valued id' )"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table WHERE id IS NULL"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor->execute)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or ($rv = $cursor->fetchrow_arrayref))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or (!defined($$rv[0]) and defined($$rv[1])))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor->finish)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or undef $cursor || 1);
|
||||
|
||||
|
||||
#
|
||||
# Finally drop the test table.
|
||||
#
|
||||
Test($state or $dbh->do("DROP TABLE $table"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
# Create the table
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
CREATE TABLE one (
|
||||
id INTEGER,
|
||||
name CHAR (64)
|
||||
)
|
||||
END_SQL
|
||||
|
||||
# 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',
|
||||
);
|
||||
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id IS NULL');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute ok' );
|
||||
my $row = $sth->fetchrow_arrayref;
|
||||
is( scalar(@$row), 2, 'Two values in the row' );
|
||||
is( $row->[0], undef, 'First column is undef' );
|
||||
is( $row->[1], 'NULL-valued id', 'Second column is defined' );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
|
|
|||
179
t/24_numrows.t
179
t/24_numrows.t
|
|
@ -9,136 +9,71 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 18;
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
sub TrueRows($) {
|
||||
my ($sth) = @_;
|
||||
my $count = 0;
|
||||
sub rows {
|
||||
my $sth = shift;
|
||||
my $expected = shift;
|
||||
my $count = 0;
|
||||
while ($sth->fetchrow_arrayref) {
|
||||
++$count;
|
||||
}
|
||||
$count;
|
||||
Test::More::is( $count, $expected, "Got $expected rows" );
|
||||
}
|
||||
|
||||
# Create a database
|
||||
my $dbh = connect_ok();
|
||||
|
||||
#
|
||||
# Main loop; leave this untouched, put tests after creating
|
||||
# the new table.
|
||||
#
|
||||
my ($dbh, $table, $def, $cursor, $numrows);
|
||||
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 CHAR (64) NOT NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
#
|
||||
# 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 ($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 ($numrows = TrueRows($cursor)) == 1)
|
||||
or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);
|
||||
|
||||
Test($state or $cursor->finish)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or undef $cursor or 1);
|
||||
|
||||
Test($state or $dbh->do("INSERT INTO $table"
|
||||
. " VALUES( 2, 'Jochen Wiedmann' )"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
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 ($numrows = TrueRows($cursor)) == 2)
|
||||
or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
|
||||
|
||||
Test($state or $cursor->finish)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or undef $cursor or 1);
|
||||
|
||||
Test($state or $dbh->do("INSERT INTO $table"
|
||||
. " VALUES(3, 'Tim Bunce')"))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
|
||||
. " WHERE id >= 2")))
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or $cursor->execute)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
Test($state or ($numrows = TrueRows($cursor)) == 2)
|
||||
or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
|
||||
|
||||
Test($state or $cursor->finish)
|
||||
or DbiError($dbh->err, $dbh->errstr);
|
||||
|
||||
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);
|
||||
# Insert into table
|
||||
ok(
|
||||
$dbh->do("INSERT INTO one VALUES ( 1, 'Alligator Descartes' )"),
|
||||
'INSERT 1',
|
||||
);
|
||||
|
||||
# Count the rows
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id = 1');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
rows( $sth, 1 );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
# Insert another row
|
||||
ok(
|
||||
$dbh->do("INSERT INTO one VALUES ( 2, 'Jochen Wiedmann' )"),
|
||||
'INSERT 2',
|
||||
);
|
||||
|
||||
# Count the rows
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id >= 1');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
rows( $sth, 2 );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
# Insert another row
|
||||
ok(
|
||||
$dbh->do("INSERT INTO one VALUES ( 3, 'Tim Bunce' )"),
|
||||
'INSERT 3',
|
||||
);
|
||||
|
||||
# Count the rows
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one WHERE id >= 2');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute' );
|
||||
rows( $sth, 2 );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,128 +9,60 @@ BEGIN {
|
|||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More tests => 14;
|
||||
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 );
|
||||
|
||||
#
|
||||
# Include lib.pl
|
||||
#
|
||||
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) NOT NULL
|
||||
)
|
||||
END_SQL
|
||||
|
||||
# Fill the table
|
||||
ok(
|
||||
$dbh->do('INSERT INTO one values ( 1, ? )', {}, 'NULL' ),
|
||||
'INSERT 1',
|
||||
);
|
||||
ok(
|
||||
$dbh->do('INSERT INTO one values ( 2, ? )', {}, ' '),
|
||||
'INSERT 2',
|
||||
);
|
||||
ok(
|
||||
$dbh->do('INSERT INTO one values ( 3, ? )', {}, ' a b c '),
|
||||
'INSERT 3',
|
||||
);
|
||||
|
||||
# Test fetching with ChopBlanks off
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one ORDER BY id');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute ok' );
|
||||
$sth->{ChopBlanks} = 0;
|
||||
my $rows = $sth->fetchall_arrayref;
|
||||
is_deeply( $rows, [
|
||||
[ 1, 'NULL' ],
|
||||
[ 2, ' ' ],
|
||||
[ 3, ' a b c ' ],
|
||||
], 'ChopBlanks = 0' );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
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;
|
||||
# Test fetching with ChopBlanks on
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare('SELECT * FROM one ORDER BY id');
|
||||
isa_ok( $sth, 'DBI::st' );
|
||||
ok( $sth->execute, '->execute ok' );
|
||||
$sth->{ChopBlanks} = 1;
|
||||
my $rows = $sth->fetchall_arrayref;
|
||||
is_deeply( $rows, [
|
||||
[ 1, 'NULL' ],
|
||||
[ 2, '' ],
|
||||
[ 3, ' a b c' ],
|
||||
], 'ChopBlanks = 1' );
|
||||
ok( $sth->finish, '->finish' );
|
||||
}
|
||||
|
||||
#
|
||||
# Main loop; leave this untouched, put tests after creating
|
||||
# the new table.
|
||||
#
|
||||
while (Testing()) {
|
||||
my ($dbh, $sth, $query);
|
||||
|
||||
#
|
||||
# Connect to the database
|
||||
Test($state or ($dbh = DBI->connect("DBI:SQLite:dbname=foo", '',
|
||||
'')))
|
||||
or ServerError();
|
||||
|
||||
#
|
||||
# Find a possible new table name
|
||||
#
|
||||
my $table = '';
|
||||
Test($state or $table = 'table1')
|
||||
or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
|
||||
$dbh->errstr);
|
||||
|
||||
#
|
||||
# Create a new table; EDIT THIS!
|
||||
#
|
||||
Test($state or ($query = TableDefinition($table,
|
||||
["id", "INTEGER", 4, $COL_NULLABLE],
|
||||
["name", "CHAR", 64, $COL_NULLABLE]),
|
||||
$dbh->do($query)))
|
||||
or ErrMsgF("Cannot create table: Error %s.\n",
|
||||
$dbh->errstr);
|
||||
|
||||
|
||||
#
|
||||
# and here's the right place for inserting new tests:
|
||||
#
|
||||
my @rows
|
||||
= ([1, 'NULL'],
|
||||
[2, ' '],
|
||||
[3, ' a b c ']);
|
||||
my $ref;
|
||||
foreach $ref (@rows) {
|
||||
my ($id, $name) = @$ref;
|
||||
if (!$state) {
|
||||
$query = sprintf("INSERT INTO $table (id, name) VALUES ($id, %s)",
|
||||
$dbh->quote($name));
|
||||
}
|
||||
Test($state or $dbh->do($query))
|
||||
or ErrMsgF("INSERT failed: query $query, error %s.\n",
|
||||
$dbh->errstr);
|
||||
$query = "SELECT id, name FROM $table WHERE id = $id\n";
|
||||
Test($state or ($sth = $dbh->prepare($query)))
|
||||
or ErrMsgF("prepare failed: query $query, error %s.\n",
|
||||
$dbh->errstr);
|
||||
|
||||
# First try to retreive without chopping blanks.
|
||||
$sth->{'ChopBlanks'} = 0;
|
||||
Test($state or $sth->execute)
|
||||
or ErrMsgF("execute failed: query %s, error %s.\n", $query,
|
||||
$sth->errstr);
|
||||
Test($state or defined($ref = $sth->fetchrow_arrayref))
|
||||
or ErrMsgF("fetch failed: query $query, error %s.\n",
|
||||
$sth->errstr);
|
||||
Test($state or ($$ref[1] eq $name))
|
||||
or ErrMsgF("problems with ChopBlanks = 0:"
|
||||
. " expected '%s', got '%s'.\n",
|
||||
$name, $$ref[1]);
|
||||
Test($state or $sth->finish());
|
||||
|
||||
# Now try to retreive with chopping blanks.
|
||||
$sth->{'ChopBlanks'} = 1;
|
||||
Test($state or $sth->execute)
|
||||
or ErrMsg("execute failed: query $query, error %s.\n",
|
||||
$sth->errstr);
|
||||
my $n = $name;
|
||||
$n =~ s/\s+$//;
|
||||
Test($state or ($ref = $sth->fetchrow_arrayref))
|
||||
or ErrMsgF("fetch failed: query $query, error %s.\n",
|
||||
$sth->errstr);
|
||||
Test($state or ($$ref[1] eq $n))
|
||||
or ErrMsgF("problems with ChopBlanks = 1:"
|
||||
. " expected '%s', got '%s'.\n",
|
||||
$n, $$ref[1]);
|
||||
|
||||
Test($state or $sth->finish)
|
||||
or ErrMsgF("Cannot finish: %s.\n", $sth->errstr);
|
||||
}
|
||||
|
||||
#
|
||||
# Finally drop the test table.
|
||||
#
|
||||
Test($state or $dbh->do("DROP TABLE $table"))
|
||||
or ErrMsgF("Cannot DROP test table $table: %s.\n",
|
||||
$dbh->errstr);
|
||||
|
||||
# ... and disconnect
|
||||
Test($state or $dbh->disconnect)
|
||||
or ErrMsgF("Cannot disconnect: %s.\n", $dbh->errmsg);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ use Test::More ();
|
|||
|
||||
use vars qw{$VERSION @ISA @EXPORT};
|
||||
BEGIN {
|
||||
$VERSION = '1.22_06';
|
||||
$VERSION = '1.22_07';
|
||||
@ISA = qw{ Exporter };
|
||||
@EXPORT = qw{ connect_ok };
|
||||
|
||||
|
|
|
|||
|
|
@ -13,11 +13,12 @@ use DBI qw(:sql_types);
|
|||
my $dbh = connect_ok();
|
||||
|
||||
$dbh->do('drop table if exists artist');
|
||||
$dbh->do(<<'');
|
||||
$dbh->do(<<'END_SQL');
|
||||
create table artist (
|
||||
id int not null primary key,
|
||||
name text not null
|
||||
)
|
||||
END_SQL
|
||||
|
||||
ok ( $dbh->do(q/insert into artist (id,name) values(1, 'Leonardo da Vinci')/), 'insert');
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue