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};
is( scalar(@$names), 4, 'Got 4 columns' );
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" );
ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
# Test aggregate on empty table
$dbh->do( "DROP TABLE aggr_empty_test;" );
$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];
}
# collation 'no_accents' will be automatically loaded on demand
$DBD::SQLite::COLLATION{no_accents} = \&no_accents;
$" = ", "; # to embed arrays into message strings
my $sql = "SELECT txt from collate_test ORDER BY txt";
# test interaction with the global COLLATION hash ("WriteOnce")
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
is($DBD::SQLite::COLLATION{foo}, \&by_num_desc, "overridden collation");
# now really test the collation functions
foreach my $call_func (@CALL_FUNCS) {
@ -126,7 +120,6 @@ foreach my $call_func (@CALL_FUNCS) {
is_deeply(\@sorted, $db_sorted,
"collate no_accents (@sorted // @$db_sorted)");
# manual addition of a collation for this dbh
$dbh->$call_func(by_length => \&by_length, "create_collation");
@sorted = sort by_length @words;
@ -135,7 +128,3 @@ foreach my $call_func (@CALL_FUNCS) {
"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
ok($n_callback);
# unregister the progress handler, set counter back to zero, do more work
ok($dbh->$call_func( $N_OPCODES, undef, "progress_handler" ));
$n_callback = 0;

1
t/15_ak_dbd.t
View file

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

1
t/21_blobtext.t
View file

@ -74,4 +74,3 @@ sub dumpblob {
}
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;
#####################################################################
# Support functions
@ -32,10 +29,6 @@ sub rows {
);
}
#####################################################################
# 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';
like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] 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);
}
# connect to an empty filename - sqlite will create a tempfile
eval {
my $dbh = DBI->connect("dbi:SQLite:dbname=", undef, undef, {
@ -110,9 +109,6 @@ eval {
is( $@, '', "Could connect to temp database (empty filename)" );
diag( $@ ) if $@;
sub _path { # copied from DBD::SQLite::connect
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 'Table Types', substr Dumper($dbh->table_info('', '', '', '%')->fetchall_arrayref), 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],
"args to authorizer (DELETE)");
# unregister the authorizer ... now DELETE should be authorized
$dbh->$call_func(undef, "set_authorizer");
eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")};
ok(!$@, "delete was accepted");
# 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
# any way to do that)
clear_warnings();
}
sub do_transaction {
my $dbh = shift;

3
t/37_regexp.t
View file

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

6
t/50_foreign_key_info.t
View file

@ -52,7 +52,6 @@ CREATE TABLE song(
);
__EOSQL__
plan tests => @sql_statements + 22;
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");
}
$sth = $dbh->foreign_key_info(undef, undef, 'artist',
undef, undef, 'album');
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([keys %$fk_data], ['albumartist'], "FK album with PK, only 1 result");
$sth = $dbh->foreign_key_info(undef, undef, 'foobar',
undef, undef, 'album');
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([keys %$fk_data], [], "FK album with PK foobar, 0 result");
$sth = $dbh->foreign_key_info(undef, undef, undef,
undef, 'remote', undef);
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([sort keys %$fk_data], [qw/albumartist albumeditor/], "FK remote.*, 2 results");
$sth = $dbh->foreign_key_info(undef, 'remote', undef,
undef, undef, undef);
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
is_deeply([sort keys %$fk_data], [qw/songalbum songartist/], "FK with PK remote.*, 2 results");
$sth = $dbh->foreign_key_info(undef, undef, undef,
undef, undef, 'song');
$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 DBD::SQLite;
use Test::More;
BEGIN {
if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) {
plan skip_all => "Column metadata is disabled for this DBD::SQLite";
}
}
use DBD::SQLite;
use Test::More;
BEGIN {
if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) {
plan skip_all => "Column metadata is disabled for this DBD::SQLite";
}
}
use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/;
use Test::NoWarnings;
plan tests => 16 * @CALL_FUNCS + 1;
for my $call_func (@CALL_FUNCS) {
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";
ok $data->{auto_increment}, "id is auto incremental";
is $data->{data_type} => 'integer', "data type is correct";
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";
ok !$data->{auto_increment}, "name space is not auto incremental";
is $data->{data_type} => undef, "data type is not defined";
ok !$data->{primary}, "name space is not a primary key";
ok !$data->{not_null}, "name space is not null";
}
# exceptions
{
local $SIG{__WARN__} = sub {};
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, '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";
$dbh->disconnect;
eval { $dbh->$call_func(undef, 'foo', 'name space', 'table_column_metadata') };
ok $@, "successfully died when dbh is inactive";
}
}
use SQLiteTest qw/connect_ok @CALL_FUNCS/;
use Test::NoWarnings;
plan tests => 16 * @CALL_FUNCS + 1;
for my $call_func (@CALL_FUNCS) {
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";
ok $data->{auto_increment}, "id is auto incremental";
is $data->{data_type} => 'integer', "data type is correct";
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";
ok !$data->{auto_increment}, "name space is not auto incremental";
is $data->{data_type} => undef, "data type is not defined";
ok !$data->{primary}, "name space is not a primary key";
ok !$data->{not_null}, "name space is not null";
}
# exceptions
{
local $SIG{__WARN__} = sub {};
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, '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";
$dbh->disconnect;
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 lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/;
use Test::More;
BEGIN { requires_sqlite('3.7.10') }
use Test::NoWarnings;
plan tests => 6 * @CALL_FUNCS + 1;
for my $func (@CALL_FUNCS) {
{
my $db = filename($func);
ok !$db, "in-memory database";
}
{
my $db = filename($func, dbfile => '');
ok !$db, "temporary database";
}
{
my $db = filename($func, dbfile => 'test.db');
like $db => qr/test\.db[\d]*$/i, "test.db";
unlink $db;
}
}
sub filename {
my $func = shift;
my $dbh = connect_ok(@_);
$dbh->$func('db_filename');
}
use SQLiteTest qw/connect_ok @CALL_FUNCS requires_sqlite/;
use Test::More;
BEGIN { requires_sqlite('3.7.10') }
use Test::NoWarnings;
plan tests => 6 * @CALL_FUNCS + 1;
for my $func (@CALL_FUNCS) {
{
my $db = filename($func);
ok !$db, "in-memory database";
}
{
my $db = filename($func, dbfile => '');
ok !$db, "temporary database";
}
{
my $db = filename($func, dbfile => 'test.db');
like $db => qr/test\.db[\d]*$/i, "test.db";
unlink $db;
}
}
sub filename {
my $func = shift;
my $dbh = connect_ok(@_);
$dbh->$func('db_filename');
}

104
t/53_status.t
View file

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

1
t/55_statistics_info.t
View file

@ -40,7 +40,6 @@ CREATE TABLE remote.b (
__EOSQL__
plan tests => @sql_statements + 2 + 46 * 2;
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;
}
}

1
t/rt_26775_distinct.t
View file

@ -50,7 +50,6 @@ for my $query (split m/ ; /xms, $slurp) {
# Then we test the bug.
#
# We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]'
#
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' );
}
######################################################################
# A well-behaved non-cached statement
@ -74,10 +70,6 @@ SCOPE: {
is( $c, 0, 'No warnings' );
}
######################################################################
# A badly-behaved regular statement
@ -105,10 +97,6 @@ SCOPE: {
is( $c, 1, 'Got a warning' );
}
######################################################################
# A well-behaved cached statement
@ -151,10 +139,6 @@ SCOPE: {
is( $c, 1, 'No warnings' );
}
#####################################################################
# 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
$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 lib "t/lib";
use SQLiteTest;
use Test::More tests => 8;
use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
eval { $dbh->do('foobar') };
ok $@, "raised error";
ok $dbh->err, "has err";
ok $dbh->errstr, "has errstr";
ok $dbh->ping, "ping succeeded";
ok $dbh->err, "err is not wiped out";
ok $dbh->errstr, "errstr is not wiped out";
use SQLiteTest;
use Test::More tests => 8;
use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
eval { $dbh->do('foobar') };
ok $@, "raised error";
ok $dbh->err, "has err";
ok $dbh->errstr, "has errstr";
ok $dbh->ping, "ping succeeded";
ok $dbh->err, "err 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 lib "t/lib";
use SQLiteTest qw/connect_ok/;
use Test::More tests => 34;
use DBI qw/:sql_types/;
my $id = 0;
for my $has_pk (0..1) {
my $dbh = connect_ok(RaiseError => 1, PrintWarn => 0, PrintError => 0);
if ($has_pk) {
$dbh->do('create table foo (id integer, v integer primary key)');
}
else {
$dbh->do('create table foo (id integer, v integer)');
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 1);
my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 1, "got correct value";
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 1.5);
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value , "not inserted/indexed";
}
else {
ok $value && $value == 1.5, "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 'foo'); # may seem weird, but that's sqlite
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value , "not inserted/indexed";
}
else {
ok $value && $value eq 'foo', "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 3, SQL_INTEGER);
my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 3, "got correct value";
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 3.5, SQL_INTEGER);
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value, "not inserted/indexed";
}
else {
ok $value && $value eq '3.5', "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 'qux', SQL_INTEGER);
# only dies if type is explicitly specified
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value, "not inserted/indexed";
}
else {
ok $value && $value eq 'qux', "got correct value";
}
}
$dbh->disconnect;
}
use SQLiteTest qw/connect_ok/;
use Test::More tests => 34;
use DBI qw/:sql_types/;
my $id = 0;
for my $has_pk (0..1) {
my $dbh = connect_ok(RaiseError => 1, PrintWarn => 0, PrintError => 0);
if ($has_pk) {
$dbh->do('create table foo (id integer, v integer primary key)');
}
else {
$dbh->do('create table foo (id integer, v integer)');
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 1);
my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 1, "got correct value";
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 1.5);
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value , "not inserted/indexed";
}
else {
ok $value && $value == 1.5, "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 'foo'); # may seem weird, but that's sqlite
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value , "not inserted/indexed";
}
else {
ok $value && $value eq 'foo', "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 3, SQL_INTEGER);
my $ret = eval { $sth->execute };
ok defined $ret, "inserted without errors";
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
ok $value && $value == 3, "got correct value";
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 3.5, SQL_INTEGER);
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value, "not inserted/indexed";
}
else {
ok $value && $value eq '3.5', "got correct value";
}
}
{
my $sth = $dbh->prepare('insert into foo values (?, ?)');
$sth->bind_param(1, ++$id);
$sth->bind_param(2, 'qux', SQL_INTEGER);
# only dies if type is explicitly specified
my $ret = eval { $sth->execute };
if ($has_pk) {
ok $@, "died correctly";
ok !defined $ret, "returns undef";
ok $sth->errstr && $sth->errstr =~ /datatype mismatch/, "insert failed: type mismatch";
}
else {
ok defined $ret, "inserted without errors";
}
my ($value) = $dbh->selectrow_array('select v from foo where id = ?', undef, $id);
if ($has_pk) {
ok !$value, "not inserted/indexed";
}
else {
ok $value && $value eq 'qux', "got correct value";
}
}
$dbh->disconnect;
}

223
t/rt_71311_bind_col_and_unicode.t
View file

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

62
t/rt_73159_fts_tokenizer_segfault.t
View file

@ -1,33 +1,33 @@
use strict;
use strict;
use warnings;
use lib "t/lib";
use SQLiteTest;
use Test::More tests => 2;
use DBI;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
sub locale_tokenizer {
return sub {
my $string = shift;
use locale;
my $regex = qr/\w+/;
my $term_index = 0;
return sub { # closure
$string =~ /$regex/g or return; # either match, or no more token
my ($start, $end) = ($-[0], $+[0]);
my $len = $end-$start;
my $term = substr($string, $start, $len);
return ($term, $len, $start, $end, $term_index++);
}
};
}
# "main::locale_tokenizer" is considered as another column name
# because of the comma after "tokenize=perl"
eval {
$dbh->do('CREATE VIRTUAL TABLE FIXMESSAGE USING FTS3(MESSAGE, tokenize=perl, "main::locale_tokenizer");');
};
ok $@, "cause an error but not segfault";
use SQLiteTest;
use Test::More tests => 2;
use DBI;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
sub locale_tokenizer {
return sub {
my $string = shift;
use locale;
my $regex = qr/\w+/;
my $term_index = 0;
return sub { # closure
$string =~ /$regex/g or return; # either match, or no more token
my ($start, $end) = ($-[0], $+[0]);
my $len = $end-$start;
my $term = substr($string, $start, $len);
return ($term, $len, $start, $end, $term_index++);
}
};
}
# "main::locale_tokenizer" is considered as another column name
# because of the comma after "tokenize=perl"
eval {
$dbh->do('CREATE VIRTUAL TABLE FIXMESSAGE USING FTS3(MESSAGE, tokenize=perl, "main::locale_tokenizer");');
};
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 lib "t/lib";
use SQLiteTest;
use Test::More tests => 4;
use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
$dbh->do($_) for
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 ('FR', 'France')];
my $sth = $dbh->primary_key_info(undef, undef, "Country Info");
my $row = $sth->fetchrow_hashref;
ok $row, 'Found the primary key column.';
is $row->{COLUMN_NAME} => "Country Code",
'Key column name reported correctly.'
or note explain $row;
use SQLiteTest;
use Test::More tests => 4;
use Test::NoWarnings;
my $dbh = connect_ok(RaiseError => 1, PrintError => 0);
$dbh->do($_) for
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 ('FR', 'France')];
my $sth = $dbh->primary_key_info(undef, undef, "Country Info");
my $row = $sth->fetchrow_hashref;
ok $row, 'Found the primary key column.';
is $row->{COLUMN_NAME} => "Country Code",
'Key column name reported correctly.'
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 lib "t/lib";
use SQLiteTest;
use Test::More;
BEGIN {
if ( $] >= 5.008005 ) {
my $tests = 27;
$tests += 2 if has_sqlite('3.6.14');
plan( tests => $tests * 2 + 1 );
} else {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::NoWarnings;
use Encode;
unicode_test("\x{263A}"); # (decoded) smiley character
unicode_test("\x{0100}"); # (decoded) capital A with macron
sub unicode_test {
my $unicode = shift;
ok Encode::is_utf8($unicode), "correctly decoded";
my $unicode_encoded = encode_utf8($unicode);
{ # tests for an environment where everything is encoded
my $dbh = connect_ok(sqlite_unicode => 0);
$dbh->do("pragma foreign_keys = on");
my $unicode_quoted = $dbh->quote_identifier($unicode_encoded);
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$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 (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode_encoded)");
$sth->bind_param(":$unicode_encoded", 5);
$sth->execute;
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode_encoded", undef, 5);
is $id => 5, "unicode placeholders";
}
{
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{id} => 1, "got correct row";
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
$sth->execute("text");
my ($id) = $sth->fetchrow_array;
is $id => 1, "got correct id by the (encoded) unicode column value";
}
{
my $sth = $dbh->column_info(undef, undef, $unicode_encoded, $unicode_encoded);
my $column_info = $sth->fetchrow_hashref;
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 $primary_key_info = $sth->fetchrow_hashref;
is $primary_key_info->{COLUMN_NAME} => $unicode_encoded, "primary_key_info returns the correctly encoded primary key name";
}
if (has_sqlite('3.6.14')) {
my $sth = $dbh->foreign_key_info(undef, undef, $unicode_encoded, undef, undef, 'bar');
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";
}
{
my $sth = $dbh->table_info(undef, undef, $unicode_encoded);
my $table_info = $sth->fetchrow_hashref;
is $table_info->{TABLE_NAME} => $unicode_encoded, "table_info returns the correctly encoded table name";
}
}
{ # tests for an environment where everything is decoded
my $dbh = connect_ok(sqlite_unicode => 1);
$dbh->do("pragma foreign_keys = on");
my $unicode_quoted = $dbh->quote_identifier($unicode);
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$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 (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode)");
$sth->bind_param(":$unicode", 5);
$sth->execute;
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode", undef, 5);
is $id => 5, "unicode placeholders";
}
{
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{id} => 1, "got correct row";
is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
$sth->execute("text2");
my ($id) = $sth->fetchrow_array;
is $id => 2, "got correct id by the (decoded) unicode column value";
}
{
my $sth = $dbh->column_info(undef, undef, $unicode, $unicode);
my $column_info = $sth->fetchrow_hashref;
is $column_info->{COLUMN_NAME} => $unicode, "column_info returns the correctly decoded column name";
}
{
my $sth = $dbh->primary_key_info(undef, undef, $unicode);
my $primary_key_info = $sth->fetchrow_hashref;
is $primary_key_info->{COLUMN_NAME} => $unicode, "primary_key_info returns the correctly decoded primary key name";
}
if (has_sqlite('3.6.14')) {
my $sth = $dbh->foreign_key_info(undef, undef, $unicode, undef, undef, 'bar');
my $foreign_key_info = $sth->fetchrow_hashref;
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 $table_info = $sth->fetchrow_hashref;
is $table_info->{TABLE_NAME} => $unicode, "table_info returns the correctly decoded table name";
}
}
}
use SQLiteTest;
use Test::More;
BEGIN {
if ( $] >= 5.008005 ) {
my $tests = 27;
$tests += 2 if has_sqlite('3.6.14');
plan( tests => $tests * 2 + 1 );
} else {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::NoWarnings;
use Encode;
unicode_test("\x{263A}"); # (decoded) smiley character
unicode_test("\x{0100}"); # (decoded) capital A with macron
sub unicode_test {
my $unicode = shift;
ok Encode::is_utf8($unicode), "correctly decoded";
my $unicode_encoded = encode_utf8($unicode);
{ # tests for an environment where everything is encoded
my $dbh = connect_ok(sqlite_unicode => 0);
$dbh->do("pragma foreign_keys = on");
my $unicode_quoted = $dbh->quote_identifier($unicode_encoded);
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$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 (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode_encoded)");
$sth->bind_param(":$unicode_encoded", 5);
$sth->execute;
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode_encoded", undef, 5);
is $id => 5, "unicode placeholders";
}
{
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{id} => 1, "got correct row";
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{$unicode_encoded} => "text", "got correct (encoded) unicode column data";
ok !exists $row->{$unicode}, "(decoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
$sth->execute("text");
my ($id) = $sth->fetchrow_array;
is $id => 1, "got correct id by the (encoded) unicode column value";
}
{
my $sth = $dbh->column_info(undef, undef, $unicode_encoded, $unicode_encoded);
my $column_info = $sth->fetchrow_hashref;
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 $primary_key_info = $sth->fetchrow_hashref;
is $primary_key_info->{COLUMN_NAME} => $unicode_encoded, "primary_key_info returns the correctly encoded primary key name";
}
if (has_sqlite('3.6.14')) {
my $sth = $dbh->foreign_key_info(undef, undef, $unicode_encoded, undef, undef, 'bar');
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";
}
{
my $sth = $dbh->table_info(undef, undef, $unicode_encoded);
my $table_info = $sth->fetchrow_hashref;
is $table_info->{TABLE_NAME} => $unicode_encoded, "table_info returns the correctly encoded table name";
}
}
{ # tests for an environment where everything is decoded
my $dbh = connect_ok(sqlite_unicode => 1);
$dbh->do("pragma foreign_keys = on");
my $unicode_quoted = $dbh->quote_identifier($unicode);
$dbh->do("create table $unicode_quoted (id, $unicode_quoted primary key)");
$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 (id, $unicode_quoted) values (?, ?)", undef, 2, "text2"), "insert with unicode name successfully";
{
my $sth = $dbh->prepare("insert into $unicode_quoted (id) values (:$unicode)");
$sth->bind_param(":$unicode", 5);
$sth->execute;
my ($id) = $dbh->selectrow_array("select id from $unicode_quoted where id = :$unicode", undef, 5);
is $id => 5, "unicode placeholders";
}
{
my $sth = $dbh->prepare("select * from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{id} => 1, "got correct row";
is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select $unicode_quoted from $unicode_quoted where id = ?");
$sth->execute(1);
my $row = $sth->fetchrow_hashref;
is $row->{$unicode} => "text", "got correct (decoded) unicode column data";
ok !exists $row->{$unicode_encoded}, "(encoded) unicode column does not exist";
}
{
my $sth = $dbh->prepare("select id from $unicode_quoted where $unicode_quoted = ?");
$sth->execute("text2");
my ($id) = $sth->fetchrow_array;
is $id => 2, "got correct id by the (decoded) unicode column value";
}
{
my $sth = $dbh->column_info(undef, undef, $unicode, $unicode);
my $column_info = $sth->fetchrow_hashref;
is $column_info->{COLUMN_NAME} => $unicode, "column_info returns the correctly decoded column name";
}
{
my $sth = $dbh->primary_key_info(undef, undef, $unicode);
my $primary_key_info = $sth->fetchrow_hashref;
is $primary_key_info->{COLUMN_NAME} => $unicode, "primary_key_info returns the correctly decoded primary key name";
}
if (has_sqlite('3.6.14')) {
my $sth = $dbh->foreign_key_info(undef, undef, $unicode, undef, undef, 'bar');
my $foreign_key_info = $sth->fetchrow_hashref;
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 $table_info = $sth->fetchrow_hashref;
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 lib "t/lib";
use SQLiteTest qw/connect_ok/;
use Test::More;
use Test::NoWarnings;
plan tests => 15 + 1;
# single column integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id integer primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# single column not-integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id text primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# multi-column primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id id, type text, primary key(type, id))");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 2, "found 2 pks";
is $pk_info[0]{COLUMN_NAME} => 'type', "first pk name is type";
is $pk_info[1]{COLUMN_NAME} => 'id', "second pk name is id";
}
# multi-column primary key with quotes
{
my $dbh = connect_ok();
$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 @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 3, "found 3 pks";
my @pk = map $_->{COLUMN_NAME}, @pk_info;
is join(' ', sort @pk) => 'a b c"d', 'all pks are 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;
is join(' ', @pk) => 'c"d b a', 'pk KEY_SEQ is correct';
}
use SQLiteTest qw/connect_ok/;
use Test::More;
use Test::NoWarnings;
plan tests => 15 + 1;
# single column integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id integer primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# single column not-integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id text primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# multi-column primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id id, type text, primary key(type, id))");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 2, "found 2 pks";
is $pk_info[0]{COLUMN_NAME} => 'type', "first pk name is type";
is $pk_info[1]{COLUMN_NAME} => 'id', "second pk name is id";
}
# multi-column primary key with quotes
{
my $dbh = connect_ok();
$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 @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 3, "found 3 pks";
my @pk = map $_->{COLUMN_NAME}, @pk_info;
is join(' ', sort @pk) => 'a b c"d', 'all pks are 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;
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)};
ok( $dbh->do($sql), 'CREATE TABLE' );
ok($dbh->do("INSERT INTO foo(docid, a, b) VALUES(1, 'a', 'b')"),
"insert without bind");
@ -48,4 +47,3 @@ ok($sth->execute(),
ok( $dbh->do("CREATE VIRTUAL TABLE foo_aux USING fts4aux(foo)"), 'FTS4AUX');
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");

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]{bar}, "auto_vivify:1", "bar column";
$sql = "SELECT * FROM foobar ";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
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 => {}});
is scalar(@$rows), 5, "got 5 rows (because of omitted constraints)";
package DBD::SQLite::VirtualTable::T;
use strict;
use warnings;
@ -49,7 +47,6 @@ sub NEW {
return $self;
}
sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_;
@ -77,8 +74,6 @@ sub BEST_INDEX {
return $outputs;
}
package DBD::SQLite::VirtualTable::T::Cursor;
use strict;
use warnings;
@ -99,8 +94,6 @@ sub FILTER {
return;
}
sub EOF {
my $self = shift;
@ -125,8 +118,4 @@ sub ROWID {
return $self->{row_count};
}
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";
is $DBD::SQLite::VirtualTable::T::CONNECT_COUNT, 1, "1 vtab connected";
package DBD::SQLite::VirtualTable::T;
use base 'DBD::SQLite::VirtualTable';
@ -71,4 +70,3 @@ sub DESTROY {$DESTROY_COUNT++}
sub DESTROY_MODULE {$DESTROY_MODULE_COUNT++}
1;

14
t/virtual_table/02_find_function.t
View file

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

4
t/virtual_table/10_filecontent.t
View file

@ -22,13 +22,11 @@ $dbh->do(<<"");
$dbh->do(<<"");
INSERT INTO base VALUES(2, 'foo2', '10_filecontent.t', 'bar2')
# start tests
ok $dbh->$sqlite_call(create_module => fs => "DBD::SQLite::VirtualTable::FileContent"),
"create_module";
ok $dbh->do(<<""), "create vtable";
CREATE VIRTUAL TABLE vfs USING fs(source = base,
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->[1]{bar}, 'bar2', 'got bar2';
# expensive request (reads content from all files in table) !
$sql = "SELECT * FROM vfs WHERE content LIKE '%filesys%'";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
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 (?)");
$sth->execute($_) foreach @perl_files;
# create the virtual table
$dbh->$sqlite_call(create_module => fc => "DBD::SQLite::VirtualTable::FileContent");
$dbh->do(<<"");
@ -92,7 +91,6 @@ foreach my $test (@tests) {
my $remove_path = 'lib/DBD/SQLite/VirtualTable.pm';
$dbh->do("DELETE FROM fts WHERE path='$remove_path'");
# test again
foreach my $test (@tests) {
my ($pattern, @expected) = @$test;
@ -113,4 +111,3 @@ foreach my $test (@tests) {
my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern);
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]{b}, 2, 'got 2 in b';
$sql = "SELECT * FROM vtb WHERE b < 8 ORDER BY a DESC";
$res = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$res), 2, "got 2 rows";
is $res->[0]{a}, 4, 'got 4 in first a';
is $res->[1]{a}, 1, 'got 1 in second a';
$sql = "SELECT rowid FROM vtb WHERE c = 'six'";
$res = $dbh->selectall_arrayref($sql, {Slice => {}});
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);
is_deeply $res, [qw/nine six/], $sql;
$dbh->do("INSERT INTO vtb(a, b, c) VALUES (11, 22, 33)");
my $row_id = $dbh->last_insert_id('', '', '', '');
is $row_id, 3, 'new rowid is 3';
is scalar(@$perl_rows), 4, 'perl_rows expanded';
is_deeply $perl_rows->[-1], [11, 22, 33], 'new row is correct';
#======================================================================
# 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->[1]{a}, 1, 'got 1 in second a';
#======================================================================
# test the colref implementation
#======================================================================
@ -104,7 +99,6 @@ $sql = "SELECT a FROM vtb WHERE a IN intarray";
$res = $dbh->selectcol_arrayref($sql);
is_deeply $res, [ 1, 7 ], "IN intarray";
# same thing with strings
our $strings = [qw/one two three/];
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
#$sql = "SELECT * FROM charinfo WHERE script='Greek' AND name MATCH '\\bSIGMA\\b'";
# but the following does work because the REGEXP operator is handled
# outside of the BEST_INDEX / FILTER methods
$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',
);
# sample data
our $perl_rows = [
[1, 2, 'three'],