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

fixed mixed EOLs and removed redundant blank lines

Browse source
This commit is contained in:
Kenichi Ishigaki 2019-01-06 05:55:34 +09:00
parent 11c2f4e70f
commit fc55eeb0d7
40 changed files with 867 additions and 975 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
t/03_create_table.t
View file

@ -28,4 +28,3 @@ ok( $sth->execute, '->execute ok' );
my $names = $sth->{NAME}; my $names = $sth->{NAME};
is( scalar(@$names), 4, 'Got 4 columns' ); is( scalar(@$names), 4, 'Got 4 columns' );
is_deeply( $names, [ 'f1', 'f1', 'f2', 'f3' ], 'Table prepending is disabled by default' ); is_deeply( $names, [ 'f1', 'f1', 'f2', 'f3' ], 'Table prepending is disabled by default' );

1
t/10_create_aggregate.t
View file

@ -88,7 +88,6 @@ foreach my $call_func (@CALL_FUNCS) { for my $flags (@function_flags) {
$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" ); $result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 ); ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
# Test aggregate on empty table # Test aggregate on empty table
$dbh->do( "DROP TABLE aggr_empty_test;" ); $dbh->do( "DROP TABLE aggr_empty_test;" );
$dbh->do( "CREATE TABLE aggr_empty_test ( field )" ); $dbh->do( "CREATE TABLE aggr_empty_test ( field )" );

11
t/13_create_collation.t
View file

@ -47,17 +47,13 @@ sub by_num_desc ($$) {
$_[1] <=> $_[0]; $_[1] <=> $_[0];
} }
# collation 'no_accents' will be automatically loaded on demand # collation 'no_accents' will be automatically loaded on demand
$DBD::SQLite::COLLATION{no_accents} = \&no_accents; $DBD::SQLite::COLLATION{no_accents} = \&no_accents;
$" = ", "; # to embed arrays into message strings $" = ", "; # to embed arrays into message strings
my $sql = "SELECT txt from collate_test ORDER BY txt"; my $sql = "SELECT txt from collate_test ORDER BY txt";
# test interaction with the global COLLATION hash ("WriteOnce") # test interaction with the global COLLATION hash ("WriteOnce")
dies (sub {$DBD::SQLite::COLLATION{perl} = sub {}}, dies (sub {$DBD::SQLite::COLLATION{perl} = sub {}},
@ -79,8 +75,6 @@ delete $tied->{foo};
$DBD::SQLite::COLLATION{foo} = \&by_num_desc; # override, no longer dies $DBD::SQLite::COLLATION{foo} = \&by_num_desc; # override, no longer dies
is($DBD::SQLite::COLLATION{foo}, \&by_num_desc, "overridden collation"); is($DBD::SQLite::COLLATION{foo}, \&by_num_desc, "overridden collation");
# now really test the collation functions # now really test the collation functions
foreach my $call_func (@CALL_FUNCS) { foreach my $call_func (@CALL_FUNCS) {
@ -126,7 +120,6 @@ foreach my $call_func (@CALL_FUNCS) {
is_deeply(\@sorted, $db_sorted, is_deeply(\@sorted, $db_sorted,
"collate no_accents (@sorted // @$db_sorted)"); "collate no_accents (@sorted // @$db_sorted)");
# manual addition of a collation for this dbh # manual addition of a collation for this dbh
$dbh->$call_func(by_length => \&by_length, "create_collation"); $dbh->$call_func(by_length => \&by_length, "create_collation");
@sorted = sort by_length @words; @sorted = sort by_length @words;
@ -135,7 +128,3 @@ foreach my $call_func (@CALL_FUNCS) {
"collate by_length (@sorted // @$db_sorted)"); "collate by_length (@sorted // @$db_sorted)");
} }
} }

1
t/14_progress_handler.t
View file

@ -38,7 +38,6 @@ foreach my $call_func (@CALL_FUNCS) {
# now the progress handler should have been called a number of times # now the progress handler should have been called a number of times
ok($n_callback); ok($n_callback);
# unregister the progress handler, set counter back to zero, do more work # unregister the progress handler, set counter back to zero, do more work
ok($dbh->$call_func( $N_OPCODES, undef, "progress_handler" )); ok($dbh->$call_func( $N_OPCODES, undef, "progress_handler" ));
$n_callback = 0; $n_callback = 0;

1
t/15_ak_dbd.t
View file

@ -110,7 +110,6 @@ SCOPE: {
ok( $sth->finish, '->finish' ); ok( $sth->finish, '->finish' );
} }
# Delete the test row from the table # Delete the test row from the table
ok( $dbh->do('DELETE FROM ONE WHERE id = 2 AND name IS NULL'), 'DELETE' ); ok( $dbh->do('DELETE FROM ONE WHERE id = 2 AND name IS NULL'), 'DELETE' );

1
t/21_blobtext.t
View file

@ -74,4 +74,3 @@ sub dumpblob {
} }
if ($ENV{SHOW_BLOBS}) { close(OUT) } if ($ENV{SHOW_BLOBS}) { close(OUT) }
} }

7
t/26_commit.t
View file

@ -9,9 +9,6 @@ use Test::More tests => 28;
my $warning_count = 0; my $warning_count = 0;
##################################################################### #####################################################################
# Support functions # Support functions
@ -32,10 +29,6 @@ sub rows {
); );
} }
##################################################################### #####################################################################
# Main Tests # Main Tests

1
t/27_metadata.t
View file

@ -51,4 +51,3 @@ isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string'; isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer'; like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer'; like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';

4
t/33_non_latin_path.t
View file

@ -98,7 +98,6 @@ foreach my $subdir ( 'longascii', 'adatb
unlink(_path($dbfilex)) if -e _path($dbfilex); unlink(_path($dbfilex)) if -e _path($dbfilex);
} }
# connect to an empty filename - sqlite will create a tempfile # connect to an empty filename - sqlite will create a tempfile
eval { eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=", undef, undef, { my $dbh = DBI->connect("dbi:SQLite:dbname=", undef, undef, {
@ -110,9 +109,6 @@ eval {
is( $@, '', "Could connect to temp database (empty filename)" ); is( $@, '', "Could connect to temp database (empty filename)" );
diag( $@ ) if $@; diag( $@ ) if $@;
sub _path { # copied from DBD::SQLite::connect sub _path { # copied from DBD::SQLite::connect
my $path = shift; my $path = shift;

1
t/35_table_info.t
View file

@ -139,4 +139,3 @@ is_deeply $info, [$table2_info, @systable_info, $table4_info, $table3_info, $tab
#warn 'Schema Names', substr Dumper($dbh->table_info('', '%', '')->fetchall_arrayref), 5; #warn 'Schema Names', substr Dumper($dbh->table_info('', '%', '')->fetchall_arrayref), 5;
#warn 'Table Types', substr Dumper($dbh->table_info('', '', '', '%')->fetchall_arrayref), 5; #warn 'Table Types', substr Dumper($dbh->table_info('', '', '', '%')->fetchall_arrayref), 5;
#warn 'table_info', substr Dumper($info), 5; #warn 'table_info', substr Dumper($info), 5;

3
t/36_hooks.t
View file

@ -122,20 +122,17 @@ foreach my $call_func (@CALL_FUNCS) {
[DBD::SQLite::DELETE, 'hook_test', undef, 'temp', undef], [DBD::SQLite::DELETE, 'hook_test', undef, 'temp', undef],
"args to authorizer (DELETE)"); "args to authorizer (DELETE)");
# unregister the authorizer ... now DELETE should be authorized # unregister the authorizer ... now DELETE should be authorized
$dbh->$call_func(undef, "set_authorizer"); $dbh->$call_func(undef, "set_authorizer");
eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")}; eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")};
ok(!$@, "delete was accepted"); ok(!$@, "delete was accepted");
# sqlite3 did warn in tests above, so avoid complains from Test::Warnings # sqlite3 did warn in tests above, so avoid complains from Test::Warnings
# (would be better to turn off warnings from sqlite3, but I didn't find # (would be better to turn off warnings from sqlite3, but I didn't find
# any way to do that) # any way to do that)
clear_warnings(); clear_warnings();
} }
sub do_transaction { sub do_transaction {
my $dbh = shift; my $dbh = shift;

3
t/37_regexp.t
View file

@ -34,8 +34,6 @@ use locale;
use DBD::SQLite; use DBD::SQLite;
foreach my $call_func (@CALL_FUNCS) { foreach my $call_func (@CALL_FUNCS) {
for my $use_unicode (0, 1) { for my $use_unicode (0, 1) {
@ -85,4 +83,3 @@ foreach my $call_func (@CALL_FUNCS) {
} }
} }
} }

228
t/43_fts3.t
View file

@ -1,118 +1,114 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok has_sqlite/; use SQLiteTest qw/connect_ok has_sqlite/;
use Test::More; use Test::More;
use DBD::SQLite; use DBD::SQLite;
my @texts = ("il était une bergère", my @texts = ("il était une bergère",
"qui gardait ses moutons", "qui gardait ses moutons",
"elle fit un fromage", "elle fit un fromage",
"du lait de ses moutons"); "du lait de ses moutons");
my @tests = ( my @tests = (
# query => expected results # query => expected results
["bergère" => 0 ], ["bergère" => 0 ],
["berg*" => 0 ], ["berg*" => 0 ],
["foobar" ], ["foobar" ],
["moutons" => 1, 3 ], ["moutons" => 1, 3 ],
['"qui gardait"' => 1 ], ['"qui gardait"' => 1 ],
["moutons NOT lait" => 1 ], ["moutons NOT lait" => 1 ],
["il était" => 0 ], ["il était" => 0 ],
["(il OR elle) AND un*" => 0, 2 ], ["(il OR elle) AND un*" => 0, 2 ],
); );
BEGIN { BEGIN {
if ($] < 5.008005) { if ($] < 5.008005) {
plan skip_all => 'Unicode is not supported before 5.8.5'; plan skip_all => 'Unicode is not supported before 5.8.5';
} }
if (!grep /ENABLE_FTS3/, DBD::SQLite::compile_options()) { if (!grep /ENABLE_FTS3/, DBD::SQLite::compile_options()) {
plan skip_all => 'FTS3 is disabled for this DBD::SQLite'; plan skip_all => 'FTS3 is disabled for this DBD::SQLite';
} }
if ($DBD::SQLite::sqlite_version_number >= 3011000 and $DBD::SQLite::sqlite_version_number < 3012000 and !grep /ENABLE_FTS3_TOKENIZER/, DBD::SQLite::compile_options()) { if ($DBD::SQLite::sqlite_version_number >= 3011000 and $DBD::SQLite::sqlite_version_number < 3012000 and !grep /ENABLE_FTS3_TOKENIZER/, DBD::SQLite::compile_options()) {
plan skip_all => 'FTS3 tokenizer is disabled for this DBD::SQLite'; plan skip_all => 'FTS3 tokenizer is disabled for this DBD::SQLite';
} }
} }
# Perl may spit a warning on locale # Perl may spit a warning on locale
# use Test::NoWarnings; # use Test::NoWarnings;
my $num = has_sqlite('3.7.4') ? 4 : 2; my $num = has_sqlite('3.7.4') ? 4 : 2;
plan tests => $num * @tests # each test with unicode y/n and with fts3/fts4 plan tests => $num * @tests # each test with unicode y/n and with fts3/fts4
+ 2; # connect_ok with unicode y/n + 2; # connect_ok with unicode y/n
BEGIN { BEGIN {
# Sadly perl for windows (and probably sqlite, too) may hang # Sadly perl for windows (and probably sqlite, too) may hang
# if the system locale doesn't support european languages. # if the system locale doesn't support european languages.
# en-us should be a safe default. if it doesn't work, use 'C'. # en-us should be a safe default. if it doesn't work, use 'C'.
if ( $^O eq 'MSWin32') { if ( $^O eq 'MSWin32') {
use POSIX 'locale_h'; use POSIX 'locale_h';
setlocale(LC_COLLATE, 'en-us'); setlocale(LC_COLLATE, 'en-us');
} }
} }
use locale;
use locale;
sub locale_tokenizer { # see also: Search::Tokenizer sub locale_tokenizer { # see also: Search::Tokenizer
return sub { return sub {
my $string = shift; my $string = shift;
my $regex = qr/\w+/;
my $regex = qr/\w+/; my $term_index = 0;
my $term_index = 0;
return sub {
return sub { $string =~ /$regex/g or return; # either match, or no more token
$string =~ /$regex/g or return; # either match, or no more token my ($start, $end) = ($-[0], $+[0]);
my ($start, $end) = ($-[0], $+[0]); my $term = substr($string, $start, my $len = $end-$start);
my $term = substr($string, $start, my $len = $end-$start); return ($term, $len, $start, $end, $term_index++);
return ($term, $len, $start, $end, $term_index++); };
}; };
}; }
}
use DBD::SQLite;
for my $use_unicode (0, 1) {
use DBD::SQLite;
# connect
my $dbh = connect_ok( RaiseError => 1, sqlite_unicode => $use_unicode );
for my $use_unicode (0, 1) { for my $fts (qw/fts3 fts4/) {
next if $fts eq 'fts4' && !has_sqlite('3.7.4');
# connect
my $dbh = connect_ok( RaiseError => 1, sqlite_unicode => $use_unicode ); # create fts table
$dbh->do(<<"") or die DBI::errstr;
for my $fts (qw/fts3 fts4/) { CREATE VIRTUAL TABLE try_$fts
next if $fts eq 'fts4' && !has_sqlite('3.7.4'); USING $fts(content, tokenize=perl 'main::locale_tokenizer')
# create fts table
$dbh->do(<<"") or die DBI::errstr; # populate it
CREATE VIRTUAL TABLE try_$fts my $insert_sth = $dbh->prepare(<<"") or die DBI::errstr;
USING $fts(content, tokenize=perl 'main::locale_tokenizer') INSERT INTO try_$fts(content) VALUES(?)
# populate it my @doc_ids;
my $insert_sth = $dbh->prepare(<<"") or die DBI::errstr; for (my $i = 0; $i < @texts; $i++) {
INSERT INTO try_$fts(content) VALUES(?) $insert_sth->execute($texts[$i]);
$doc_ids[$i] = $dbh->last_insert_id("", "", "", "");
my @doc_ids; }
for (my $i = 0; $i < @texts; $i++) {
$insert_sth->execute($texts[$i]); # queries
$doc_ids[$i] = $dbh->last_insert_id("", "", "", ""); SKIP: {
} skip "These tests require SQLite compiled with "
. "ENABLE_FTS3_PARENTHESIS option", scalar @tests
# queries unless DBD::SQLite->can('compile_options') &&
SKIP: { grep /ENABLE_FTS3_PARENTHESIS/, DBD::SQLite::compile_options();
skip "These tests require SQLite compiled with "
. "ENABLE_FTS3_PARENTHESIS option", scalar @tests my $sql = "SELECT docid FROM try_$fts WHERE content MATCH ?";
unless DBD::SQLite->can('compile_options') &&
grep /ENABLE_FTS3_PARENTHESIS/, DBD::SQLite::compile_options(); for my $t (@tests) {
my $sql = "SELECT docid FROM try_$fts WHERE content MATCH ?"; my ($query, @expected) = @$t;
for my $t (@tests) { @expected = map {$doc_ids[$_]} @expected;
my ($query, @expected) = @$t; my $results = $dbh->selectcol_arrayref($sql, undef, $query);
@expected = map {$doc_ids[$_]} @expected; is_deeply($results, \@expected, "$query ($fts, unicode=$use_unicode)");
my $results = $dbh->selectcol_arrayref($sql, undef, $query); }
is_deeply($results, \@expected, "$query ($fts, unicode=$use_unicode)"); }
} }
} }
}
}

114
t/49_trace_and_profile.t
View file

@ -1,59 +1,59 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/; use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/;
use Test::More; use Test::More;
BEGIN { requires_sqlite('3.6.21') } BEGIN { requires_sqlite('3.6.21') }
use Test::NoWarnings; use Test::NoWarnings;
plan tests => 12 * @CALL_FUNCS + 1; plan tests => 12 * @CALL_FUNCS + 1;
my $flag = 0; my $flag = 0;
for my $call_func (@CALL_FUNCS) { for my $call_func (@CALL_FUNCS) {
my $dbh = connect_ok(); my $dbh = connect_ok();
# sqlite_trace should always be called as sqlite_trace, # sqlite_trace should always be called as sqlite_trace,
# i.e. $dbh->func(..., "sqlite_trace") and $dbh->sqlite_trace(...) # i.e. $dbh->func(..., "sqlite_trace") and $dbh->sqlite_trace(...)
my $func_name = $flag++ ? "trace" : "sqlite_trace"; my $func_name = $flag++ ? "trace" : "sqlite_trace";
# trace # trace
my @trace; my @trace;
$dbh->$call_func(sub { push @trace, [@_] }, $func_name); $dbh->$call_func(sub { push @trace, [@_] }, $func_name);
$dbh->do('create table foo (id integer)'); $dbh->do('create table foo (id integer)');
is $trace[0][0] => "create table foo (id integer)"; is $trace[0][0] => "create table foo (id integer)";
$dbh->do('insert into foo values (?)', undef, 1); $dbh->do('insert into foo values (?)', undef, 1);
is $trace[1][0] => "insert into foo values ('1')"; is $trace[1][0] => "insert into foo values ('1')";
$dbh->$call_func(undef, $func_name); $dbh->$call_func(undef, $func_name);
$dbh->do('insert into foo values (?)', undef, 2); $dbh->do('insert into foo values (?)', undef, 2);
is @trace => 2; is @trace => 2;
$dbh->$call_func(sub { push @trace, [@_] }, $func_name); $dbh->$call_func(sub { push @trace, [@_] }, $func_name);
$dbh->do('insert into foo values (?)', undef, 3); $dbh->do('insert into foo values (?)', undef, 3);
is $trace[2][0] => "insert into foo values ('3')"; is $trace[2][0] => "insert into foo values ('3')";
# profile # profile
my @profile; my @profile;
$dbh->$call_func(sub { push @profile, [@_] }, "profile"); $dbh->$call_func(sub { push @profile, [@_] }, "profile");
$dbh->do('create table bar (id integer)'); $dbh->do('create table bar (id integer)');
is $profile[0][0] => "create table bar (id integer)"; is $profile[0][0] => "create table bar (id integer)";
like $profile[0][1] => qr/^[0-9]+$/; like $profile[0][1] => qr/^[0-9]+$/;
$dbh->do('insert into bar values (?)', undef, 1); $dbh->do('insert into bar values (?)', undef, 1);
is $profile[1][0] => "insert into bar values (?)"; is $profile[1][0] => "insert into bar values (?)";
like $profile[1][1] => qr/^[0-9]+$/; like $profile[1][1] => qr/^[0-9]+$/;
$dbh->$call_func(undef, "profile"); $dbh->$call_func(undef, "profile");
$dbh->do('insert into bar values (?)', undef, 2); $dbh->do('insert into bar values (?)', undef, 2);
is @profile => 2; is @profile => 2;
$dbh->$call_func(sub { push @profile, [@_] }, "profile"); $dbh->$call_func(sub { push @profile, [@_] }, "profile");
$dbh->do('insert into bar values (?)', undef, 3); $dbh->do('insert into bar values (?)', undef, 3);
is $profile[2][0] => "insert into bar values (?)"; is $profile[2][0] => "insert into bar values (?)";
like $profile[2][1] => qr/^[0-9]+$/; like $profile[2][1] => qr/^[0-9]+$/;
} }

6
t/50_foreign_key_info.t
View file

@ -52,7 +52,6 @@ CREATE TABLE song(
); );
__EOSQL__ __EOSQL__
plan tests => @sql_statements + 22; plan tests => @sql_statements + 22;
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 ); my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
@ -86,31 +85,26 @@ for ($fk_data->{albumeditor}) {
is($_->{UNIQUE_OR_PRIMARY}, 'PRIMARY', "FK albumeditor, primary"); is($_->{UNIQUE_OR_PRIMARY}, 'PRIMARY', "FK albumeditor, primary");
} }
$sth = $dbh->foreign_key_info(undef, undef, 'artist', $sth = $dbh->foreign_key_info(undef, undef, 'artist',
undef, undef, 'album'); undef, undef, 'album');
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME'); $fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([keys %$fk_data], ['albumartist'], "FK album with PK, only 1 result"); is_deeply([keys %$fk_data], ['albumartist'], "FK album with PK, only 1 result");
$sth = $dbh->foreign_key_info(undef, undef, 'foobar', $sth = $dbh->foreign_key_info(undef, undef, 'foobar',
undef, undef, 'album'); undef, undef, 'album');
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME'); $fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([keys %$fk_data], [], "FK album with PK foobar, 0 result"); is_deeply([keys %$fk_data], [], "FK album with PK foobar, 0 result");
$sth = $dbh->foreign_key_info(undef, undef, undef, $sth = $dbh->foreign_key_info(undef, undef, undef,
undef, 'remote', undef); undef, 'remote', undef);
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME'); $fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([sort keys %$fk_data], [qw/albumartist albumeditor/], "FK remote.*, 2 results"); is_deeply([sort keys %$fk_data], [qw/albumartist albumeditor/], "FK remote.*, 2 results");
$sth = $dbh->foreign_key_info(undef, 'remote', undef, $sth = $dbh->foreign_key_info(undef, 'remote', undef,
undef, undef, undef); undef, undef, undef);
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME'); $fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([sort keys %$fk_data], [qw/songalbum songartist/], "FK with PK remote.*, 2 results"); is_deeply([sort keys %$fk_data], [qw/songalbum songartist/], "FK with PK remote.*, 2 results");
$sth = $dbh->foreign_key_info(undef, undef, undef, $sth = $dbh->foreign_key_info(undef, undef, undef,
undef, undef, 'song'); undef, undef, 'song');
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME'); $fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');

115
t/51_table_column_metadata.t
View file

@ -1,59 +1,60 @@
use strict; use strict;
use warnings; use warnings;
use DBD::SQLite; use DBD::SQLite;
use Test::More; use Test::More;
BEGIN { BEGIN {
if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) { if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) {
plan skip_all => "Column metadata is disabled for this DBD::SQLite"; plan skip_all => "Column metadata is disabled for this DBD::SQLite";
} }
} }
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/; use SQLiteTest qw/connect_ok @CALL_FUNCS/;
use Test::NoWarnings; use Test::NoWarnings;
plan tests => 16 * @CALL_FUNCS + 1; plan tests => 16 * @CALL_FUNCS + 1;
for my $call_func (@CALL_FUNCS) {
my $dbh = connect_ok(RaiseError => 1); for my $call_func (@CALL_FUNCS) {
$dbh->do('create table foo (id integer primary key autoincrement, "name space", unique_col integer unique)'); my $dbh = connect_ok(RaiseError => 1);
$dbh->do('create table foo (id integer primary key autoincrement, "name space", unique_col integer unique)');
{
my $data = $dbh->$call_func(undef, 'foo', 'id', 'table_column_metadata'); {
ok $data && ref $data eq ref {}, "got a metadata"; my $data = $dbh->$call_func(undef, 'foo', 'id', 'table_column_metadata');
ok $data->{auto_increment}, "id is auto incremental"; ok $data && ref $data eq ref {}, "got a metadata";
is $data->{data_type} => 'integer', "data type is correct"; ok $data->{auto_increment}, "id is auto incremental";
ok $data->{primary}, "id is a primary key"; is $data->{data_type} => 'integer', "data type is correct";
ok !$data->{not_null}, "id is not null"; ok $data->{primary}, "id is a primary key";
} ok !$data->{not_null}, "id is not null";
}
{
my $data = $dbh->$call_func(undef, 'foo', 'name space', 'table_column_metadata'); {
ok $data && ref $data eq ref {}, "got a metadata"; my $data = $dbh->$call_func(undef, 'foo', 'name space', 'table_column_metadata');
ok !$data->{auto_increment}, "name space is not auto incremental"; ok $data && ref $data eq ref {}, "got a metadata";
is $data->{data_type} => undef, "data type is not defined"; ok !$data->{auto_increment}, "name space is not auto incremental";
ok !$data->{primary}, "name space is not a primary key"; is $data->{data_type} => undef, "data type is not defined";
ok !$data->{not_null}, "name space is not null"; ok !$data->{primary}, "name space is not a primary key";
} ok !$data->{not_null}, "name space is not null";
}
# exceptions
{ # exceptions
local $SIG{__WARN__} = sub {}; {
eval { $dbh->$call_func(undef, undef, 'name space', 'table_column_metadata') }; local $SIG{__WARN__} = sub {};
ok $@, "successfully died when tablename is undef"; eval { $dbh->$call_func(undef, undef, 'name space', 'table_column_metadata') };
ok $@, "successfully died when tablename is undef";
eval { $dbh->$call_func(undef, '', 'name space', 'table_column_metadata') };
ok !$@, "not died when tablename is an empty string"; eval { $dbh->$call_func(undef, '', 'name space', 'table_column_metadata') };
ok !$@, "not died when tablename is an empty string";
eval { $dbh->$call_func(undef, 'foo', undef, 'table_column_metadata') };
ok $@, "successfully died when columnname is undef"; eval { $dbh->$call_func(undef, 'foo', undef, 'table_column_metadata') };
ok $@, "successfully died when columnname is undef";
eval { $dbh->$call_func(undef, 'foo', '', 'table_column_metadata') };
ok !$@, "not died when columnname is an empty string"; eval { $dbh->$call_func(undef, 'foo', '', 'table_column_metadata') };
ok !$@, "not died when columnname is an empty string";
$dbh->disconnect;
$dbh->disconnect;
eval { $dbh->$call_func(undef, 'foo', 'name space', 'table_column_metadata') };
ok $@, "successfully died when dbh is inactive"; eval { $dbh->$call_func(undef, 'foo', 'name space', 'table_column_metadata') };
} ok $@, "successfully died when dbh is inactive";
} }
}

66
t/52_db_filename.t
View file

@ -1,35 +1,35 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/; use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/;
use Test::More; use Test::More;
BEGIN { requires_sqlite('3.7.10') } BEGIN { requires_sqlite('3.7.10') }
use Test::NoWarnings; use Test::NoWarnings;
plan tests => 6 * @CALL_FUNCS + 1; plan tests => 6 * @CALL_FUNCS + 1;
for my $func (@CALL_FUNCS) { for my $func (@CALL_FUNCS) {
{ {
my $db = filename($func); my $db = filename($func);
ok !$db, "in-memory database"; ok !$db, "in-memory database";
} }
{ {
my $db = filename($func, dbfile => ''); my $db = filename($func, dbfile => '');
ok !$db, "temporary database"; ok !$db, "temporary database";
} }
{ {
my $db = filename($func, dbfile => 'test.db'); my $db = filename($func, dbfile => 'test.db');
like $db => qr/test\.db[\d]*$/i, "test.db"; like $db => qr/test\.db[\d]*$/i, "test.db";
unlink $db; unlink $db;
} }
} }
sub filename { sub filename {
my $func = shift; my $func = shift;
my $dbh = connect_ok(@_); my $dbh = connect_ok(@_);
$dbh->$func('db_filename'); $dbh->$func('db_filename');
} }

104
t/53_status.t
View file

@ -1,54 +1,54 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS has_sqlite/; use SQLiteTest qw/connect_ok @CALL_FUNCS has_sqlite/;
use Test::More; use Test::More;
use Test::NoWarnings; use Test::NoWarnings;
my $tests = 3; my $tests = 3;
$tests += 2 if has_sqlite('3.6.4'); $tests += 2 if has_sqlite('3.6.4');
$tests += 1 if has_sqlite('3.7.0'); $tests += 1 if has_sqlite('3.7.0');
plan tests => 4 + $tests * @CALL_FUNCS + 1; plan tests => 4 + $tests * @CALL_FUNCS + 1;
my $dbh = connect_ok(); my $dbh = connect_ok();
{ {
$dbh->do('create table foo (id integer primary key, text)'); $dbh->do('create table foo (id integer primary key, text)');
my $sth = $dbh->prepare('insert into foo values(?, ?)'); my $sth = $dbh->prepare('insert into foo values(?, ?)');
$sth->execute($_, "text$_") for 1..100; $sth->execute($_, "text$_") for 1..100;
} }
{ {
my $status = DBD::SQLite::sqlite_status(); my $status = DBD::SQLite::sqlite_status();
ok $status && ref $status eq ref {}, "status is a hashref"; ok $status && ref $status eq ref {}, "status is a hashref";
my $num_of_keys = scalar keys %$status; my $num_of_keys = scalar keys %$status;
ok $num_of_keys, "status: $num_of_keys indicators"; ok $num_of_keys, "status: $num_of_keys indicators";
my $used_mem = $status->{memory_used}{current}; my $used_mem = $status->{memory_used}{current};
ok defined $used_mem && $used_mem, "current used memory: $used_mem"; ok defined $used_mem && $used_mem, "current used memory: $used_mem";
} }
for my $func (@CALL_FUNCS) { for my $func (@CALL_FUNCS) {
{ {
my $db_status = $dbh->$func('db_status'); my $db_status = $dbh->$func('db_status');
ok $db_status && ref $db_status eq ref {}, "db status is a hashref"; ok $db_status && ref $db_status eq ref {}, "db status is a hashref";
my $num_of_keys = scalar keys %$db_status; my $num_of_keys = scalar keys %$db_status;
ok $num_of_keys, "db status: $num_of_keys indicators"; ok $num_of_keys, "db status: $num_of_keys indicators";
if (has_sqlite('3.7.0')) { if (has_sqlite('3.7.0')) {
my $used_cache = $db_status->{cache_used}{current}; my $used_cache = $db_status->{cache_used}{current};
ok defined $used_cache && $used_cache, "current used cache: $used_cache"; ok defined $used_cache && $used_cache, "current used cache: $used_cache";
} }
} }
{ {
my $sth = $dbh->prepare('select * from foo where text = ? order by text desc'); my $sth = $dbh->prepare('select * from foo where text = ? order by text desc');
$sth->execute("text1"); $sth->execute("text1");
my $st_status = $sth->$func('st_status'); my $st_status = $sth->$func('st_status');
ok $st_status && ref $st_status eq ref {}, "st status is a hashref"; ok $st_status && ref $st_status eq ref {}, "st status is a hashref";
if (has_sqlite('3.6.4')) { if (has_sqlite('3.6.4')) {
my $num_of_keys = scalar keys %$st_status; my $num_of_keys = scalar keys %$st_status;
ok $num_of_keys, "st status: $num_of_keys indicators"; ok $num_of_keys, "st status: $num_of_keys indicators";
my $sort = $st_status->{sort}; my $sort = $st_status->{sort};
ok defined $sort, "num of sort: $sort"; ok defined $sort, "num of sort: $sort";
} }
} }
} }

42
t/54_literal_txn.t
View file

@ -1,23 +1,23 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok/; use SQLiteTest qw/connect_ok/;
use Test::More tests => 5; use Test::More tests => 5;
use Test::NoWarnings; use Test::NoWarnings;
my $dbh = connect_ok(); my $dbh = connect_ok();
is $dbh->{AutoCommit}, 1, is $dbh->{AutoCommit}, 1,
'AutoCommit=1 at connection'; 'AutoCommit=1 at connection';
$dbh->do("\n-- my DDL file\n-- some comment\nBEGIN TRANSACTION"); $dbh->do("\n-- my DDL file\n-- some comment\nBEGIN TRANSACTION");
is $dbh->{AutoCommit}, '', is $dbh->{AutoCommit}, '',
"AutoCommit='' after 'BEGIN TRANSACTION'"; "AutoCommit='' after 'BEGIN TRANSACTION'";
$dbh->do("SELECT 1 FROM sqlite_master LIMIT 1"); $dbh->do("SELECT 1 FROM sqlite_master LIMIT 1");
$dbh->do("\nCOMMIT"); $dbh->do("\nCOMMIT");
is $dbh->{AutoCommit}, 1, is $dbh->{AutoCommit}, 1,
'AutoCommit=1 after "\nCOMMIT"'; 'AutoCommit=1 after "\nCOMMIT"';

1
t/55_statistics_info.t
View file

@ -40,7 +40,6 @@ CREATE TABLE remote.b (
__EOSQL__ __EOSQL__
plan tests => @sql_statements + 2 + 46 * 2; plan tests => @sql_statements + 2 + 46 * 2;
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 ); my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );

1
t/62_regexp_multibyte_char_class.t
View file

@ -45,4 +45,3 @@ foreach my $call_func (@CALL_FUNCS) {
note explain $db_match; note explain $db_match;
} }
} }

1
t/rt_26775_distinct.t
View file

@ -50,7 +50,6 @@ for my $query (split m/ ; /xms, $slurp) {
# Then we test the bug. # Then we test the bug.
# #
# We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]' # We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]'
# #
my $query_with_parens = trim(q{ my $query_with_parens = trim(q{

16
t/rt_32889_prepare_cached_reexecute.t
View file

@ -37,10 +37,6 @@ sub fetchrow_1 {
is_deeply( $row, [ 1 ], 'Got row 1' ); is_deeply( $row, [ 1 ], 'Got row 1' );
} }
###################################################################### ######################################################################
# A well-behaved non-cached statement # A well-behaved non-cached statement
@ -74,10 +70,6 @@ SCOPE: {
is( $c, 0, 'No warnings' ); is( $c, 0, 'No warnings' );
} }
###################################################################### ######################################################################
# A badly-behaved regular statement # A badly-behaved regular statement
@ -105,10 +97,6 @@ SCOPE: {
is( $c, 1, 'Got a warning' ); is( $c, 1, 'Got a warning' );
} }
###################################################################### ######################################################################
# A well-behaved cached statement # A well-behaved cached statement
@ -151,10 +139,6 @@ SCOPE: {
is( $c, 1, 'No warnings' ); is( $c, 1, 'No warnings' );
} }
##################################################################### #####################################################################
# Badly-behaved prepare_cached (but still acceptable) # Badly-behaved prepare_cached (but still acceptable)

1
t/rt_48393_debug_panic_with_commit.t
View file

@ -54,4 +54,3 @@ $sth->execute;
# XXX: Panic occurs here when running under the debugger # XXX: Panic occurs here when running under the debugger
$dbh->commit or die $dbh->errstr; $dbh->commit or die $dbh->errstr;

26
t/rt_64177_ping_wipes_out_the_errstr.t
View file

@ -1,15 +1,15 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More tests => 8; use Test::More tests => 8;
use Test::NoWarnings; use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0); my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
eval { $dbh->do('foobar') }; eval { $dbh->do('foobar') };
ok $@, "raised error"; ok $@, "raised error";
ok $dbh->err, "has err"; ok $dbh->err, "has err";
ok $dbh->errstr, "has errstr"; ok $dbh->errstr, "has errstr";
ok $dbh->ping, "ping succeeded"; ok $dbh->ping, "ping succeeded";
ok $dbh->err, "err is not wiped out"; ok $dbh->err, "err is not wiped out";
ok $dbh->errstr, "errstr is not wiped out"; ok $dbh->errstr, "errstr is not wiped out";

278
t/rt_67581_bind_params_mismatch.t
View file

@ -1,141 +1,141 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok/; use SQLiteTest qw/connect_ok/;
use Test::More tests => 34; use Test::More tests => 34;
use DBI qw/:sql_types/; use DBI qw/:sql_types/;
my $id = 0; my $id = 0;
for my $has_pk (0..1) { for my $has_pk (0..1) {
my $dbh = connect_ok(RaiseError => 1, PrintWarn => 0, PrintError => 0); my $dbh = connect_ok(RaiseError => 1, PrintWarn => 0, PrintError => 0);
if ($has_pk) { if ($has_pk) {
$dbh->do('create table foo (id integer, v integer primary key)'); $dbh->do('create table foo (id integer, v integer primary key)');
} }
else { else {
$dbh->do('create table foo (id integer, v integer)'); $dbh->do('create table foo (id integer, v integer)');
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 1); $sth->bind_param(2, 1);
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 1, "got correct value"; ok $value && $value == 1, "got correct value";
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 1.5); $sth->bind_param(2, 1.5);
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
if ($has_pk) { if ($has_pk) {
ok $@, "died correctly"; ok $@, "died correctly";
ok !defined $ret, "returns undef"; ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch"; ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
} }
else { else {
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
} }
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) { if ($has_pk) {
ok !$value , "not inserted/indexed"; ok !$value , "not inserted/indexed";
} }
else { else {
ok $value && $value == 1.5, "got correct value"; ok $value && $value == 1.5, "got correct value";
} }
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 'foo'); # may seem weird, but that's sqlite $sth->bind_param(2, 'foo'); # may seem weird, but that's sqlite
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
if ($has_pk) { if ($has_pk) {
ok $@, "died correctly"; ok $@, "died correctly";
ok !defined $ret, "returns undef"; ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch"; ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
} }
else { else {
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
} }
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) { if ($has_pk) {
ok !$value , "not inserted/indexed"; ok !$value , "not inserted/indexed";
} }
else { else {
ok $value && $value eq 'foo', "got correct value"; ok $value && $value eq 'foo', "got correct value";
} }
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 3, SQL_INTEGER); $sth->bind_param(2, 3, SQL_INTEGER);
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 3, "got correct value"; ok $value && $value == 3, "got correct value";
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 3.5, SQL_INTEGER); $sth->bind_param(2, 3.5, SQL_INTEGER);
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
if ($has_pk) { if ($has_pk) {
ok $@, "died correctly"; ok $@, "died correctly";
ok !defined $ret, "returns undef"; ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch"; ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
} }
else { else {
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
} }
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) { if ($has_pk) {
ok !$value, "not inserted/indexed"; ok !$value, "not inserted/indexed";
} }
else { else {
ok $value && $value eq '3.5', "got correct value"; ok $value && $value eq '3.5', "got correct value";
} }
} }
{ {
my $sth = $dbh->prepare('insert into foo values (?, ?)'); my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id); $sth->bind_param(1, ++$id);
$sth->bind_param(2, 'qux', SQL_INTEGER); $sth->bind_param(2, 'qux', SQL_INTEGER);
# only dies if type is explicitly specified # only dies if type is explicitly specified
my $ret = eval { $sth->execute }; my $ret = eval { $sth->execute };
if ($has_pk) { if ($has_pk) {
ok $@, "died correctly"; ok $@, "died correctly";
ok !defined $ret, "returns undef"; ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch"; ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
} }
else { else {
ok defined $ret, "inserted without errors"; ok defined $ret, "inserted without errors";
} }
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id); my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) { if ($has_pk) {
ok !$value, "not inserted/indexed"; ok !$value, "not inserted/indexed";
} }
else { else {
ok $value && $value eq 'qux', "got correct value"; ok $value && $value eq 'qux', "got correct value";
} }
} }
$dbh->disconnect; $dbh->disconnect;
} }

223
t/rt_71311_bind_col_and_unicode.t
View file

@ -1,113 +1,114 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok/; use SQLiteTest qw/connect_ok/;
use Test::More; use Test::More;
BEGIN { BEGIN {
if ( $] >= 5.008005 ) { if ( $] >= 5.008005 ) {
plan( tests => 50 ); plan( tests => 50 );
} 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; use Test::NoWarnings;
use DBI qw/:sql_types/; use DBI qw/:sql_types/;
my $dbh = connect_ok(sqlite_unicode => 1); my $dbh = connect_ok(sqlite_unicode => 1);
$dbh->do('create table test1 (id integer, b blob)'); $dbh->do('create table test1 (id integer, b blob)');
my $blob = "\x{82}\x{A0}"; my $blob = "\x{82}\x{A0}";
my $str = "\x{20ac}"; my $str = "\x{20ac}";
{ {
my $sth = $dbh->prepare('insert into test1 values (?, ?)'); my $sth = $dbh->prepare('insert into test1 values (?, ?)');
$sth->execute(1, $blob); $sth->execute(1, $blob);
$sth->bind_param(1, 2);; $sth->bind_param(1, 2);;
$sth->bind_param(2, $blob, SQL_BLOB); $sth->bind_param(2, $blob, SQL_BLOB);
$sth->execute; $sth->execute;
$sth->bind_param(1, 3);; $sth->bind_param(1, 3);;
$sth->bind_param(2, $blob, {TYPE => SQL_BLOB}); $sth->bind_param(2, $blob, {TYPE => SQL_BLOB});
$sth->execute; $sth->execute;
$sth->bind_param(2, undef, SQL_VARCHAR); $sth->bind_param(2, undef, SQL_VARCHAR);
$sth->execute(4, $str); $sth->execute(4, $str);
$sth->bind_param(1, 5);; $sth->bind_param(1, 5);;
$sth->bind_param(2, utf8::encode($str), SQL_BLOB); $sth->bind_param(2, utf8::encode($str), SQL_BLOB);
$sth->execute; $sth->execute;
$sth->bind_param(1, 6);; $sth->bind_param(1, 6);;
$sth->bind_param(2, utf8::encode($str), {TYPE => SQL_BLOB}); $sth->bind_param(2, utf8::encode($str), {TYPE => SQL_BLOB});
$sth->execute; $sth->execute;
$sth->finish; $sth->finish;
} }
{ {
my $sth = $dbh->prepare('select * from test1 order by id'); my $sth = $dbh->prepare('select * from test1 order by id');
$sth->execute;
$sth->execute;
my $expected = [undef, 1, 0, 0, 1, 1, 1];
for (1..6) { my $expected = [undef, 1, 0, 0, 1, 1, 1];
my $row = $sth->fetch; for (1..6) {
my $row = $sth->fetch;
ok $row && $row->[0] == $_;
ok $row && utf8::is_utf8($row->[1]) == $expected->[$_], ok $row && $row->[0] == $_;
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode"); ok $row && utf8::is_utf8($row->[1]) == $expected->[$_],
} "row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
$sth->finish; }
}
$sth->finish;
{ }
my $sth = $dbh->prepare('select * from test1 order by id');
$sth->bind_col(1, \my $col1); {
$sth->bind_col(2, \my $col2); my $sth = $dbh->prepare('select * from test1 order by id');
$sth->execute; $sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2);
my $expected = [undef, 1, 0, 0, 1, 1, 1]; $sth->execute;
for (1..6) {
$sth->fetch; my $expected = [undef, 1, 0, 0, 1, 1, 1];
for (1..6) {
ok $col1 && $col1 == $_; $sth->fetch;
ok $col1 && utf8::is_utf8($col2) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode"); ok $col1 && $col1 == $_;
} ok $col1 && utf8::is_utf8($col2) == $expected->[$_],
$sth->finish; "row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
} }
$sth->finish;
{ }
my $sth = $dbh->prepare('select * from test1 order by id');
$sth->bind_col(1, \my $col1); {
$sth->bind_col(2, \my $col2, SQL_BLOB); my $sth = $dbh->prepare('select * from test1 order by id');
$sth->execute; $sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2, SQL_BLOB);
my $expected = [undef, 0, 0, 0, 0, 0, 0]; $sth->execute;
for (1..6) {
$sth->fetch; my $expected = [undef, 0, 0, 0, 0, 0, 0];
for (1..6) {
ok $col1 && $col1 == $_; $sth->fetch;
ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode"); ok $col1 && $col1 == $_;
} ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
$sth->finish; "row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
} }
$sth->finish;
{ }
my $sth = $dbh->prepare('select * from test1 order by id');
$sth->bind_col(1, \my $col1); {
$sth->bind_col(2, \my $col2, {TYPE => SQL_BLOB}); my $sth = $dbh->prepare('select * from test1 order by id');
$sth->execute; $sth->bind_col(1, \my $col1);
$sth->bind_col(2, \my $col2, {TYPE => SQL_BLOB});
my $expected = [undef, 0, 0, 0, 0, 0, 0]; $sth->execute;
for (1..6) {
$sth->fetch; my $expected = [undef, 0, 0, 0, 0, 0, 0];
for (1..6) {
ok $col1 && $col1 == $_; $sth->fetch;
ok $col2 && utf8::is_utf8($col2) == $expected->[$_], ok $col1 && $col1 == $_;
"row $_ is ".($expected->[$_] ? "unicode" : "not unicode"); ok $col2 && utf8::is_utf8($col2) == $expected->[$_],
} "row $_ is ".($expected->[$_] ? "unicode" : "not unicode");
$sth->finish; }
} $sth->finish;
}

62
t/rt_73159_fts_tokenizer_segfault.t
View file

@ -1,33 +1,33 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More tests => 2; use Test::More tests => 2;
use DBI; use DBI;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0); my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
sub locale_tokenizer { sub locale_tokenizer {
return sub { return sub {
my $string = shift; my $string = shift;
use locale; use locale;
my $regex = qr/\w+/; my $regex = qr/\w+/;
my $term_index = 0; my $term_index = 0;
return sub { # closure return sub { # closure
$string =~ /$regex/g or return; # either match, or no more token $string =~ /$regex/g or return; # either match, or no more token
my ($start, $end) = ($-[0], $+[0]); my ($start, $end) = ($-[0], $+[0]);
my $len = $end-$start; my $len = $end-$start;
my $term = substr($string, $start, $len); my $term = substr($string, $start, $len);
return ($term, $len, $start, $end, $term_index++); return ($term, $len, $start, $end, $term_index++);
} }
}; };
} }
# "main::locale_tokenizer" is considered as another column name # "main::locale_tokenizer" is considered as another column name
# because of the comma after "tokenize=perl" # because of the comma after "tokenize=perl"
eval { eval {
$dbh->do('CREATE VIRTUAL TABLE FIXMESSAGE USING FTS3(MESSAGE, tokenize=perl, "main::locale_tokenizer");'); $dbh->do('CREATE VIRTUAL TABLE FIXMESSAGE USING FTS3(MESSAGE, tokenize=perl, "main::locale_tokenizer");');
}; };
ok $@, "cause an error but not segfault"; ok $@, "cause an error but not segfault";

38
t/rt_77724_primary_key_with_a_whitespace.t
View file

@ -1,21 +1,21 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More tests => 4; use Test::More tests => 4;
use Test::NoWarnings; use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0); my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
$dbh->do($_) for $dbh->do($_) for
q[CREATE TABLE "Country Info" ("Country Code" CHAR(2) PRIMARY KEY, "Name" VARCHAR(200))], q[CREATE TABLE "Country Info" ("Country Code" CHAR(2) PRIMARY KEY, "Name" VARCHAR(200))],
q[INSERT INTO "Country Info" VALUES ('DE', 'Germany')], q[INSERT INTO "Country Info" VALUES ('DE', 'Germany')],
q[INSERT INTO "Country Info" VALUES ('FR', 'France')]; q[INSERT INTO "Country Info" VALUES ('FR', 'France')];
my $sth = $dbh->primary_key_info(undef, undef, "Country Info"); my $sth = $dbh->primary_key_info(undef, undef, "Country Info");
my $row = $sth->fetchrow_hashref; my $row = $sth->fetchrow_hashref;
ok $row, 'Found the primary key column.'; ok $row, 'Found the primary key column.';
is $row->{COLUMN_NAME} => "Country Code", is $row->{COLUMN_NAME} => "Country Code",
'Key column name reported correctly.' 'Key column name reported correctly.'
or note explain $row; or note explain $row;

323
t/rt_78833_utf8_flag_for_column_names.t
View file

@ -1,164 +1,163 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN { BEGIN {
if ( $] >= 5.008005 ) { if ( $] >= 5.008005 ) {
my $tests = 27; my $tests = 27;
$tests += 2 if has_sqlite('3.6.14'); $tests += 2 if has_sqlite('3.6.14');
plan( tests => $tests * 2 + 1 ); plan( tests => $tests * 2 + 1 );
} 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; use Test::NoWarnings;
use Encode; use Encode;
unicode_test("\x{263A}"); # (decoded) smiley character unicode_test("\x{263A}"); # (decoded) smiley character
unicode_test("\x{0100}"); # (decoded) capital A with macron unicode_test("\x{0100}"); # (decoded) capital A with macron
sub unicode_test { sub unicode_test {
my $unicode = shift; my $unicode = shift;
ok Encode::is_utf8($unicode), "correctly decoded"; ok Encode::is_utf8($unicode), "correctly decoded";
my $unicode_encoded = encode_utf8($unicode); my $unicode_encoded = encode_utf8($unicode);
{ # tests for an environment where everything is encoded { # tests for an environment where everything is encoded
my $dbh = connect_ok(sqlite_unicode => 0); my $dbh = connect_ok(sqlite_unicode => 0);
$dbh->do("pragma foreign_keys = on"); $dbh->do("pragma foreign_keys = on");
my $unicode_quoted = $dbh->quote_identifier($unicode_encoded); my $unicode_quoted = $dbh->quote_identifier($unicode_encoded);
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)"); $dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$dbh->do("create table bar (id, ref references $unicode_quoted ($unicode_encoded))"); $dbh->do("create table bar (id, ref references $unicode_quoted ($unicode_encoded))");
ok $dbh->do("insert into $unicode_quoted values (?, ?)", undef, 1, "text"), "insert successfully"; ok $dbh->do("insert into $unicode_quoted values (?, ?)", undef, 1, "text"), "insert successfully";
ok $dbh->do("insert into $unicode_quoted (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully"; ok $dbh->do("insert into $unicode_quoted (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{ {
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode_encoded)"); my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode_encoded)");
$sth->bind_param(":$unicode_encoded", 5); $sth->bind_param(":$unicode_encoded", 5);
$sth->execute; $sth->execute;
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode_encoded", undef, 5); my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode_encoded", undef, 5);
is $id => 5, "unicode placeholders"; is $id => 5, "unicode placeholders";
} }
{ {
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?"); my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
$sth->execute(1); $sth->execute(1);
my $row = $sth->fetchrow_hashref; my $row = $sth->fetchrow_hashref;
is $row->{id} => 1, "got correct row"; is $row->{id} => 1, "got correct row";
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data"; is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist"; ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
} }
{ {
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?"); my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
$sth->execute(1); $sth->execute(1);
my $row = $sth->fetchrow_hashref; my $row = $sth->fetchrow_hashref;
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data"; is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist"; ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
} }
{ {
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?"); my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
$sth->execute("text"); $sth->execute("text");
my ($id) = $sth->fetchrow_array; my ($id) = $sth->fetchrow_array;
is $id => 1, "got correct id by the (encoded) unicode column value"; is $id => 1, "got correct id by the (encoded) unicode column value";
} }
{ {
my $sth = $dbh->column_info(undef, undef, $unicode_encoded, $unicode_encoded); my $sth = $dbh->column_info(undef, undef, $unicode_encoded, $unicode_encoded);
my $column_info = $sth->fetchrow_hashref; my $column_info = $sth->fetchrow_hashref;
is $column_info->{COLUMN_NAME} => $unicode_encoded, "column_info returns the correctly encoded column name"; is $column_info->{COLUMN_NAME} => $unicode_encoded, "column_info returns the correctly encoded column name";
} }
{ {
my $sth = $dbh->primary_key_info(undef, undef, $unicode_encoded); my $sth = $dbh->primary_key_info(undef, undef, $unicode_encoded);
my $primary_key_info = $sth->fetchrow_hashref; my $primary_key_info = $sth->fetchrow_hashref;
is $primary_key_info->{COLUMN_NAME} => $unicode_encoded, "primary_key_info returns the correctly encoded primary key name"; is $primary_key_info->{COLUMN_NAME} => $unicode_encoded, "primary_key_info returns the correctly encoded primary key name";
} }
if (has_sqlite('3.6.14')) { if (has_sqlite('3.6.14')) {
my $sth = $dbh->foreign_key_info(undef, undef, $unicode_encoded, undef, undef, 'bar'); my $sth = $dbh->foreign_key_info(undef, undef, $unicode_encoded, undef, undef, 'bar');
my $foreign_key_info = $sth->fetchrow_hashref; my $foreign_key_info = $sth->fetchrow_hashref;
is $foreign_key_info->{PKCOLUMN_NAME} => $unicode_encoded, "foreign_key_info returns the correctly encoded foreign key name"; is $foreign_key_info->{PKCOLUMN_NAME} => $unicode_encoded, "foreign_key_info returns the correctly encoded foreign key name";
} }
{ {
my $sth = $dbh->table_info(undef, undef, $unicode_encoded); my $sth = $dbh->table_info(undef, undef, $unicode_encoded);
my $table_info = $sth->fetchrow_hashref; my $table_info = $sth->fetchrow_hashref;
is $table_info->{TABLE_NAME} => $unicode_encoded, "table_info returns the correctly encoded table name"; is $table_info->{TABLE_NAME} => $unicode_encoded, "table_info returns the correctly encoded table name";
} }
} }
{ # tests for an environment where everything is decoded { # tests for an environment where everything is decoded
my $dbh = connect_ok(sqlite_unicode => 1);
my $dbh = connect_ok(sqlite_unicode => 1); $dbh->do("pragma foreign_keys = on");
$dbh->do("pragma foreign_keys = on"); my $unicode_quoted = $dbh->quote_identifier($unicode);
my $unicode_quoted = $dbh->quote_identifier($unicode); $dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)"); $dbh->do("create table bar (id, ref references $unicode_quoted ($unicode_quoted))");
$dbh->do("create table bar (id, ref references $unicode_quoted ($unicode_quoted))");
ok $dbh->do("insert into $unicode_quoted values (?, ?)", undef, 1, "text"), "insert successfully";
ok $dbh->do("insert into $unicode_quoted values (?, ?)", undef, 1, "text"), "insert successfully"; ok $dbh->do("insert into $unicode_quoted (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
ok $dbh->do("insert into $unicode_quoted (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{
{ my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode)");
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode)"); $sth->bind_param(":$unicode", 5);
$sth->bind_param(":$unicode", 5); $sth->execute;
$sth->execute; my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode", undef, 5);
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode", undef, 5); is $id => 5, "unicode placeholders";
is $id => 5, "unicode placeholders"; }
}
{
{ my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?"); $sth->execute(1);
$sth->execute(1); my $row = $sth->fetchrow_hashref;
my $row = $sth->fetchrow_hashref; is $row->{id} => 1, "got correct row";
is $row->{id} => 1, "got correct row"; is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
is $row->{$unicode} => "text", "got correct (decoded) unicode column data"; ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist"; }
}
{
{ my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?"); $sth->execute(1);
$sth->execute(1); my $row = $sth->fetchrow_hashref;
my $row = $sth->fetchrow_hashref; is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
is $row->{$unicode} => "text", "got correct (decoded) unicode column data"; ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist"; }
}
{
{ my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?"); $sth->execute("text2");
$sth->execute("text2"); my ($id) = $sth->fetchrow_array;
my ($id) = $sth->fetchrow_array; is $id => 2, "got correct id by the (decoded) unicode column value";
is $id => 2, "got correct id by the (decoded) unicode column value"; }
}
{
{ my $sth = $dbh->column_info(undef, undef, $unicode, $unicode);
my $sth = $dbh->column_info(undef, undef, $unicode, $unicode); my $column_info = $sth->fetchrow_hashref;
my $column_info = $sth->fetchrow_hashref; is $column_info->{COLUMN_NAME} => $unicode, "column_info returns the correctly decoded column name";
is $column_info->{COLUMN_NAME} => $unicode, "column_info returns the correctly decoded column name"; }
}
{
{ my $sth = $dbh->primary_key_info(undef, undef, $unicode);
my $sth = $dbh->primary_key_info(undef, undef, $unicode); my $primary_key_info = $sth->fetchrow_hashref;
my $primary_key_info = $sth->fetchrow_hashref; is $primary_key_info->{COLUMN_NAME} => $unicode, "primary_key_info returns the correctly decoded primary key name";
is $primary_key_info->{COLUMN_NAME} => $unicode, "primary_key_info returns the correctly decoded primary key name"; }
}
if (has_sqlite('3.6.14')) {
if (has_sqlite('3.6.14')) { my $sth = $dbh->foreign_key_info(undef, undef, $unicode, undef, undef, 'bar');
my $sth = $dbh->foreign_key_info(undef, undef, $unicode, undef, undef, 'bar'); my $foreign_key_info = $sth->fetchrow_hashref;
my $foreign_key_info = $sth->fetchrow_hashref; is $foreign_key_info->{PKCOLUMN_NAME} => $unicode, "foreign_key_info returns the correctly decoded foreign key name";
is $foreign_key_info->{PKCOLUMN_NAME} => $unicode, "foreign_key_info returns the correctly decoded foreign key name"; }
}
{
{ my $sth = $dbh->table_info(undef, undef, $unicode);
my $sth = $dbh->table_info(undef, undef, $unicode); my $table_info = $sth->fetchrow_hashref;
my $table_info = $sth->fetchrow_hashref; is $table_info->{TABLE_NAME} => $unicode, "table_info returns the correctly decoded table name";
is $table_info->{TABLE_NAME} => $unicode, "table_info returns the correctly decoded table name"; }
} }
} }
}

118
t/rt_81536_multi_column_primary_key_info.t
View file

@ -1,61 +1,61 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok/; use SQLiteTest qw/connect_ok/;
use Test::More; use Test::More;
use Test::NoWarnings; use Test::NoWarnings;
plan tests => 15 + 1; plan tests => 15 + 1;
# single column integer primary key # single column integer primary key
{ {
my $dbh = connect_ok(); my $dbh = connect_ok();
$dbh->do("create table foo (id integer primary key, type text)"); $dbh->do("create table foo (id integer primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo'); my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info; my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row }; while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks"; is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id"; is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
} }
# single column not-integer primary key # single column not-integer primary key
{ {
my $dbh = connect_ok(); my $dbh = connect_ok();
$dbh->do("create table foo (id text primary key, type text)"); $dbh->do("create table foo (id text primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo'); my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info; my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row }; while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks"; is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id"; is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
} }
# multi-column primary key # multi-column primary key
{ {
my $dbh = connect_ok(); my $dbh = connect_ok();
$dbh->do("create table foo (id id, type text, primary key(type, id))"); $dbh->do("create table foo (id id, type text, primary key(type, id))");
my $sth = $dbh->primary_key_info(undef, undef, 'foo'); my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info; my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row }; while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 2, "found 2 pks"; is @pk_info => 2, "found 2 pks";
is $pk_info[0]{COLUMN_NAME} => 'type', "first pk name is type"; is $pk_info[0]{COLUMN_NAME} => 'type', "first pk name is type";
is $pk_info[1]{COLUMN_NAME} => 'id', "second pk name is id"; is $pk_info[1]{COLUMN_NAME} => 'id', "second pk name is id";
} }
# multi-column primary key with quotes # multi-column primary key with quotes
{ {
my $dbh = connect_ok(); my $dbh = connect_ok();
$dbh->do('create table foo (a, b, "c""d", unique(a, b, "c""d"), primary key( "c""d", [b], `a` ))'); $dbh->do('create table foo (a, b, "c""d", unique(a, b, "c""d"), primary key( "c""d", [b], `a` ))');
my $sth = $dbh->primary_key_info(undef, undef, 'foo'); my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info; my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row }; while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 3, "found 3 pks"; is @pk_info => 3, "found 3 pks";
my @pk = map $_->{COLUMN_NAME}, @pk_info; my @pk = map $_->{COLUMN_NAME}, @pk_info;
is join(' ', sort @pk) => 'a b c"d', 'all pks are correct'; is join(' ', sort @pk) => 'a b c"d', 'all pks are correct';
is join(' ', @pk) => 'c"d b a', 'pk order is correct'; is join(' ', @pk) => 'c"d b a', 'pk order is correct';
@pk = map $_->{COLUMN_NAME}, sort {$a->{KEY_SEQ} <=> $b->{KEY_SEQ}} @pk_info; @pk = map $_->{COLUMN_NAME}, sort {$a->{KEY_SEQ} <=> $b->{KEY_SEQ}} @pk_info;
is join(' ', @pk) => 'c"d b a', 'pk KEY_SEQ is correct'; is join(' ', @pk) => 'c"d b a', 'pk KEY_SEQ is correct';
} }

2
t/rt_96878_fts_contentless_table.t
View file

@ -24,7 +24,6 @@ my $dbh = connect_ok(RaiseError => 1, AutoCommit => 1);
my $sql = q{CREATE VIRTUAL TABLE foo USING fts4 (content="", a, b)}; my $sql = q{CREATE VIRTUAL TABLE foo USING fts4 (content="", a, b)};
ok( $dbh->do($sql), 'CREATE TABLE' ); ok( $dbh->do($sql), 'CREATE TABLE' );
ok($dbh->do("INSERT INTO foo(docid, a, b) VALUES(1, 'a', 'b')"), ok($dbh->do("INSERT INTO foo(docid, a, b) VALUES(1, 'a', 'b')"),
"insert without bind"); "insert without bind");
@ -48,4 +47,3 @@ ok($sth->execute(),
ok( $dbh->do("CREATE VIRTUAL TABLE foo_aux USING fts4aux(foo)"), 'FTS4AUX'); ok( $dbh->do("CREATE VIRTUAL TABLE foo_aux USING fts4aux(foo)"), 'FTS4AUX');
my $data = $dbh->selectcol_arrayref("select term from foo_aux where col='*'"); my $data = $dbh->selectcol_arrayref("select term from foo_aux where col='*'");
is_deeply ([sort @$data], [qw/a aa aaa b bb bbb/], "terms properly indexed"); is_deeply ([sort @$data], [qw/a aa aaa b bb bbb/], "terms properly indexed");

11
t/virtual_table/00_base.t
View file

@ -20,7 +20,6 @@ is $rows->[0]{rowid}, 5, "rowid column";
is $rows->[0]{foo}, "auto_vivify:0", "foo column"; is $rows->[0]{foo}, "auto_vivify:0", "foo column";
is $rows->[0]{bar}, "auto_vivify:1", "bar column"; is $rows->[0]{bar}, "auto_vivify:1", "bar column";
$sql = "SELECT * FROM foobar "; $sql = "SELECT * FROM foobar ";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}}); $rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 5, "got 5 rows again"; is scalar(@$rows), 5, "got 5 rows again";
@ -31,7 +30,6 @@ $sql = "SELECT * FROM foobar WHERE foo > -1 and bar < 33";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}}); $rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 5, "got 5 rows (because of omitted constraints)"; is scalar(@$rows), 5, "got 5 rows (because of omitted constraints)";
package DBD::SQLite::VirtualTable::T; package DBD::SQLite::VirtualTable::T;
use strict; use strict;
use warnings; use warnings;
@ -49,7 +47,6 @@ sub NEW {
return $self; return $self;
} }
sub BEST_INDEX { sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_; my ($self, $constraints, $order_by) = @_;
@ -77,8 +74,6 @@ sub BEST_INDEX {
return $outputs; return $outputs;
} }
package DBD::SQLite::VirtualTable::T::Cursor; package DBD::SQLite::VirtualTable::T::Cursor;
use strict; use strict;
use warnings; use warnings;
@ -99,8 +94,6 @@ sub FILTER {
return; return;
} }
sub EOF { sub EOF {
my $self = shift; my $self = shift;
@ -125,8 +118,4 @@ sub ROWID {
return $self->{row_count}; return $self->{row_count};
} }
1; 1;

2
t/virtual_table/01_destroy.t
View file

@ -52,7 +52,6 @@ my $sth = $dbh->prepare("SELECT * FROM barfoo");
ok !$DBD::SQLite::VirtualTable::T::CREATE_COUNT, "no vtab created"; ok !$DBD::SQLite::VirtualTable::T::CREATE_COUNT, "no vtab created";
is $DBD::SQLite::VirtualTable::T::CONNECT_COUNT, 1, "1 vtab connected"; is $DBD::SQLite::VirtualTable::T::CONNECT_COUNT, 1, "1 vtab connected";
package DBD::SQLite::VirtualTable::T; package DBD::SQLite::VirtualTable::T;
use base 'DBD::SQLite::VirtualTable'; use base 'DBD::SQLite::VirtualTable';
@ -71,4 +70,3 @@ sub DESTROY {$DESTROY_COUNT++}
sub DESTROY_MODULE {$DESTROY_MODULE_COUNT++} sub DESTROY_MODULE {$DESTROY_MODULE_COUNT++}
1; 1;

14
t/virtual_table/02_find_function.t
View file

@ -7,7 +7,6 @@ use Test::NoWarnings;
plan tests => 15; plan tests => 15;
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 ); my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
$dbh->$sqlite_call(create_module => vtab => "DBD::SQLite::VirtualTable::T"); $dbh->$sqlite_call(create_module => vtab => "DBD::SQLite::VirtualTable::T");
@ -50,7 +49,6 @@ is $DBD::SQLite::VirtualTable::T::funcs{abs}{calls}, 1, "abs still 1";
is $DBD::SQLite::VirtualTable::T::funcs{substr}{calls}, 1, "substr still 1"; is $DBD::SQLite::VirtualTable::T::funcs{substr}{calls}, 1, "substr still 1";
is $DBD::SQLite::VirtualTable::T::funcs{trim}{calls}, 1, "trim still 1"; is $DBD::SQLite::VirtualTable::T::funcs{trim}{calls}, 1, "trim still 1";
# new table : should issue new calls to FIND_FUNCTION # new table : should issue new calls to FIND_FUNCTION
ok $dbh->do("CREATE VIRTUAL TABLE barfoo USING vtab(foo INTEGER, bar INTEGER)"), ok $dbh->do("CREATE VIRTUAL TABLE barfoo USING vtab(foo INTEGER, bar INTEGER)"),
"created barfoo"; "created barfoo";
@ -66,7 +64,6 @@ is $DBD::SQLite::VirtualTable::T::funcs{abs}{calls}, 2, "abs now 2";
is $DBD::SQLite::VirtualTable::T::funcs{substr}{calls}, 2, "substr now 2"; is $DBD::SQLite::VirtualTable::T::funcs{substr}{calls}, 2, "substr now 2";
is $DBD::SQLite::VirtualTable::T::funcs{trim}{calls}, 2, "trim now 2"; is $DBD::SQLite::VirtualTable::T::funcs{trim}{calls}, 2, "trim now 2";
# drop table : should free references to functions # drop table : should free references to functions
ok $dbh->do("DROP TABLE foobar"); ok $dbh->do("DROP TABLE foobar");
@ -75,14 +72,11 @@ undef $dbh;
note "done"; note "done";
package DBD::SQLite::VirtualTable::T; package DBD::SQLite::VirtualTable::T;
use strict; use strict;
use warnings; use warnings;
use base 'DBD::SQLite::VirtualTable'; use base 'DBD::SQLite::VirtualTable';
sub BEST_INDEX { sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_; my ($self, $constraints, $order_by) = @_;
@ -106,7 +100,6 @@ sub BEST_INDEX {
our %funcs; our %funcs;
sub FIND_FUNCTION { sub FIND_FUNCTION {
my ($self, $n_arg, $function_name) = @_; my ($self, $n_arg, $function_name) = @_;
@ -115,7 +108,6 @@ sub FIND_FUNCTION {
return $func; return $func;
} }
package DBD::SQLite::VirtualTable::T::Cursor; package DBD::SQLite::VirtualTable::T::Cursor;
use strict; use strict;
use warnings; use warnings;
@ -136,8 +128,6 @@ sub FILTER {
return; return;
} }
sub EOF { sub EOF {
my $self = shift; my $self = shift;
@ -162,8 +152,4 @@ sub ROWID {
return $self->{row_count}; return $self->{row_count};
} }
1; 1;

4
t/virtual_table/10_filecontent.t
View file

@ -22,13 +22,11 @@ $dbh->do(<<"");
$dbh->do(<<""); $dbh->do(<<"");
INSERT INTO base VALUES(2, 'foo2', '10_filecontent.t', 'bar2') INSERT INTO base VALUES(2, 'foo2', '10_filecontent.t', 'bar2')
# start tests # start tests
ok $dbh->$sqlite_call(create_module => fs => "DBD::SQLite::VirtualTable::FileContent"), ok $dbh->$sqlite_call(create_module => fs => "DBD::SQLite::VirtualTable::FileContent"),
"create_module"; "create_module";
ok $dbh->do(<<""), "create vtable"; ok $dbh->do(<<""), "create vtable";
CREATE VIRTUAL TABLE vfs USING fs(source = base, CREATE VIRTUAL TABLE vfs USING fs(source = base,
expose = "path, foo, bar", expose = "path, foo, bar",
@ -51,9 +49,7 @@ is_deeply([sort keys %{$rows->[0]}], [qw/bar content foo path/], "col list OK");
is $rows->[0]{bar}, 'bar1', 'got bar1'; is $rows->[0]{bar}, 'bar1', 'got bar1';
is $rows->[1]{bar}, 'bar2', 'got bar2'; is $rows->[1]{bar}, 'bar2', 'got bar2';
# expensive request (reads content from all files in table) ! # expensive request (reads content from all files in table) !
$sql = "SELECT * FROM vfs WHERE content LIKE '%filesys%'"; $sql = "SELECT * FROM vfs WHERE content LIKE '%filesys%'";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}}); $rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 1, "got 1 row"; is scalar(@$rows), 1, "got 1 row";

3
t/virtual_table/11_filecontent_fulltext.t
View file

@ -66,7 +66,6 @@ $dbh->do("CREATE TABLE files (id INTEGER PRIMARY KEY, path TEXT)");
my $sth = $dbh->prepare("INSERT INTO files(path) VALUES (?)"); my $sth = $dbh->prepare("INSERT INTO files(path) VALUES (?)");
$sth->execute($_) foreach @perl_files; $sth->execute($_) foreach @perl_files;
# create the virtual table # create the virtual table
$dbh->$sqlite_call(create_module => fc => "DBD::SQLite::VirtualTable::FileContent"); $dbh->$sqlite_call(create_module => fc => "DBD::SQLite::VirtualTable::FileContent");
$dbh->do(<<""); $dbh->do(<<"");
@ -92,7 +91,6 @@ foreach my $test (@tests) {
my $remove_path = 'lib/DBD/SQLite/VirtualTable.pm'; my $remove_path = 'lib/DBD/SQLite/VirtualTable.pm';
$dbh->do("DELETE FROM fts WHERE path='$remove_path'"); $dbh->do("DELETE FROM fts WHERE path='$remove_path'");
# test again # test again
foreach my $test (@tests) { foreach my $test (@tests) {
my ($pattern, @expected) = @$test; my ($pattern, @expected) = @$test;
@ -113,4 +111,3 @@ foreach my $test (@tests) {
my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern); my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern);
is_deeply([sort @$paths], \@expected, "search '$pattern' -- after reconnect"); is_deeply([sort @$paths], \@expected, "search '$pattern' -- after reconnect");
} }

6
t/virtual_table/20_perldata.t
View file

@ -39,14 +39,12 @@ is scalar(@$res), 3, "got 3 rows";
is $res->[0]{a}, 1, 'got 1 in a'; is $res->[0]{a}, 1, 'got 1 in a';
is $res->[0]{b}, 2, 'got 2 in b'; is $res->[0]{b}, 2, 'got 2 in b';
$sql = "SELECT * FROM vtb WHERE b < 8 ORDER BY a DESC"; $sql = "SELECT * FROM vtb WHERE b < 8 ORDER BY a DESC";
$res = $dbh->selectall_arrayref($sql, {Slice => {}}); $res = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$res), 2, "got 2 rows"; is scalar(@$res), 2, "got 2 rows";
is $res->[0]{a}, 4, 'got 4 in first a'; is $res->[0]{a}, 4, 'got 4 in first a';
is $res->[1]{a}, 1, 'got 1 in second a'; is $res->[1]{a}, 1, 'got 1 in second a';
$sql = "SELECT rowid FROM vtb WHERE c = 'six'"; $sql = "SELECT rowid FROM vtb WHERE c = 'six'";
$res = $dbh->selectall_arrayref($sql, {Slice => {}}); $res = $dbh->selectall_arrayref($sql, {Slice => {}});
is_deeply $res, [{rowid => 2}], $sql; is_deeply $res, [{rowid => 2}], $sql;
@ -56,14 +54,12 @@ $sql = "SELECT c FROM vtb WHERE c MATCH 'i' ORDER BY c";
$res = $dbh->selectcol_arrayref($sql); $res = $dbh->selectcol_arrayref($sql);
is_deeply $res, [qw/nine six/], $sql; is_deeply $res, [qw/nine six/], $sql;
$dbh->do("INSERT INTO vtb(a, b, c) VALUES (11, 22, 33)"); $dbh->do("INSERT INTO vtb(a, b, c) VALUES (11, 22, 33)");
my $row_id = $dbh->last_insert_id('', '', '', ''); my $row_id = $dbh->last_insert_id('', '', '', '');
is $row_id, 3, 'new rowid is 3'; is $row_id, 3, 'new rowid is 3';
is scalar(@$perl_rows), 4, 'perl_rows expanded'; is scalar(@$perl_rows), 4, 'perl_rows expanded';
is_deeply $perl_rows->[-1], [11, 22, 33], 'new row is correct'; is_deeply $perl_rows->[-1], [11, 22, 33], 'new row is correct';
#====================================================================== #======================================================================
# test the hashref implementation # test the hashref implementation
#====================================================================== #======================================================================
@ -79,7 +75,6 @@ is scalar(@$res), 2, "got 2 rows";
is $res->[0]{a}, 4, 'got 4 in first a'; is $res->[0]{a}, 4, 'got 4 in first a';
is $res->[1]{a}, 1, 'got 1 in second a'; is $res->[1]{a}, 1, 'got 1 in second a';
#====================================================================== #======================================================================
# test the colref implementation # test the colref implementation
#====================================================================== #======================================================================
@ -104,7 +99,6 @@ $sql = "SELECT a FROM vtb WHERE a IN intarray";
$res = $dbh->selectcol_arrayref($sql); $res = $dbh->selectcol_arrayref($sql);
is_deeply $res, [ 1, 7 ], "IN intarray"; is_deeply $res, [ 1, 7 ], "IN intarray";
# same thing with strings # same thing with strings
our $strings = [qw/one two three/]; our $strings = [qw/one two three/];
ok $dbh->do(<<""), "create vtable strarray"; ok $dbh->do(<<""), "create vtable strarray";

1
t/virtual_table/21_perldata_charinfo.t
View file

@ -49,7 +49,6 @@ is $res->[0]{block}, $sigma_block, "letter in proper block";
# the following does not work because \b gets escaped as a literal # the following does not work because \b gets escaped as a literal
#$sql = "SELECT * FROM charinfo WHERE script='Greek' AND name MATCH '\\bSIGMA\\b'"; #$sql = "SELECT * FROM charinfo WHERE script='Greek' AND name MATCH '\\bSIGMA\\b'";
# but the following does work because the REGEXP operator is handled # but the following does work because the REGEXP operator is handled
# outside of the BEST_INDEX / FILTER methods # outside of the BEST_INDEX / FILTER methods
$sql = "SELECT * FROM charinfo WHERE script='Greek' AND name REGEXP '\\bSIGMA\\b'"; $sql = "SELECT * FROM charinfo WHERE script='Greek' AND name REGEXP '\\bSIGMA\\b'";

1
t/virtual_table/rt_99748.t
View file

@ -18,7 +18,6 @@ my @interpolation_attempts = (
'$self', '$self',
); );
# sample data # sample data
our $perl_rows = [ our $perl_rows = [
[1, 2, 'three'], [1, 2, 'three'],