From fc55eeb0d78233981d40d3b8110e72b6d0f1e5ad Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Sun, 6 Jan 2019 05:55:34 +0900 Subject: [PATCH] fixed mixed EOLs and removed redundant blank lines --- t/03_create_table.t | 1 - t/10_create_aggregate.t | 1 - t/13_create_collation.t | 11 - t/14_progress_handler.t | 1 - t/15_ak_dbd.t | 1 - t/21_blobtext.t | 1 - t/26_commit.t | 7 - t/27_metadata.t | 1 - t/33_non_latin_path.t | 4 - t/35_table_info.t | 1 - t/36_hooks.t | 3 - t/37_regexp.t | 3 - t/43_fts3.t | 228 +++++++-------- t/49_trace_and_profile.t | 114 ++++---- t/50_foreign_key_info.t | 6 - t/51_table_column_metadata.t | 115 ++++---- t/52_db_filename.t | 66 ++--- t/53_status.t | 104 +++---- t/54_literal_txn.t | 42 +-- t/55_statistics_info.t | 1 - t/62_regexp_multibyte_char_class.t | 1 - t/rt_26775_distinct.t | 1 - t/rt_32889_prepare_cached_reexecute.t | 16 - t/rt_48393_debug_panic_with_commit.t | 1 - t/rt_64177_ping_wipes_out_the_errstr.t | 26 +- t/rt_67581_bind_params_mismatch.t | 278 +++++++++--------- t/rt_71311_bind_col_and_unicode.t | 223 +++++++------- t/rt_73159_fts_tokenizer_segfault.t | 62 ++-- t/rt_77724_primary_key_with_a_whitespace.t | 38 +-- t/rt_78833_utf8_flag_for_column_names.t | 323 ++++++++++----------- t/rt_81536_multi_column_primary_key_info.t | 118 ++++---- t/rt_96878_fts_contentless_table.t | 2 - t/virtual_table/00_base.t | 11 - t/virtual_table/01_destroy.t | 2 - t/virtual_table/02_find_function.t | 14 - t/virtual_table/10_filecontent.t | 4 - t/virtual_table/11_filecontent_fulltext.t | 3 - t/virtual_table/20_perldata.t | 6 - t/virtual_table/21_perldata_charinfo.t | 1 - t/virtual_table/rt_99748.t | 1 - 40 files changed, 867 insertions(+), 975 deletions(-) diff --git a/t/03_create_table.t b/t/03_create_table.t index fddf3b7..89badb6 100644 --- a/t/03_create_table.t +++ b/t/03_create_table.t @@ -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' ); - diff --git a/t/10_create_aggregate.t b/t/10_create_aggregate.t index fa5fafc..f2455d9 100644 --- a/t/10_create_aggregate.t +++ b/t/10_create_aggregate.t @@ -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 )" ); diff --git a/t/13_create_collation.t b/t/13_create_collation.t index 4a0e130..fbaff66 100644 --- a/t/13_create_collation.t +++ b/t/13_create_collation.t @@ -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)"); } } - - - - diff --git a/t/14_progress_handler.t b/t/14_progress_handler.t index 4466cc1..6ed7f61 100644 --- a/t/14_progress_handler.t +++ b/t/14_progress_handler.t @@ -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; diff --git a/t/15_ak_dbd.t b/t/15_ak_dbd.t index a2d8db3..4524f66 100644 --- a/t/15_ak_dbd.t +++ b/t/15_ak_dbd.t @@ -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' ); diff --git a/t/21_blobtext.t b/t/21_blobtext.t index a0aebde..3d3251c 100644 --- a/t/21_blobtext.t +++ b/t/21_blobtext.t @@ -74,4 +74,3 @@ sub dumpblob { } if ($ENV{SHOW_BLOBS}) { close(OUT) } } - diff --git a/t/26_commit.t b/t/26_commit.t index 7e9912f..1e75c73 100644 --- a/t/26_commit.t +++ b/t/26_commit.t @@ -9,9 +9,6 @@ use Test::More tests => 28; my $warning_count = 0; - - - ##################################################################### # Support functions @@ -32,10 +29,6 @@ sub rows { ); } - - - - ##################################################################### # Main Tests diff --git a/t/27_metadata.t b/t/27_metadata.t index 67dabda..f14dd16 100644 --- a/t/27_metadata.t +++ b/t/27_metadata.t @@ -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'; - diff --git a/t/33_non_latin_path.t b/t/33_non_latin_path.t index 1f124e3..29d455f 100644 --- a/t/33_non_latin_path.t +++ b/t/33_non_latin_path.t @@ -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; diff --git a/t/35_table_info.t b/t/35_table_info.t index a70540d..ed39d76 100644 --- a/t/35_table_info.t +++ b/t/35_table_info.t @@ -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; - diff --git a/t/36_hooks.t b/t/36_hooks.t index 347e64e..66ecb76 100644 --- a/t/36_hooks.t +++ b/t/36_hooks.t @@ -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; diff --git a/t/37_regexp.t b/t/37_regexp.t index ed2ffe0..eeae6d5 100644 --- a/t/37_regexp.t +++ b/t/37_regexp.t @@ -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) { } } } - diff --git a/t/43_fts3.t b/t/43_fts3.t index 6483b50..36d010d 100644 --- a/t/43_fts3.t +++ b/t/43_fts3.t @@ -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)"); + } + } + } +} diff --git a/t/49_trace_and_profile.t b/t/49_trace_and_profile.t index a5b77ae..f97060d 100644 --- a/t/49_trace_and_profile.t +++ b/t/49_trace_and_profile.t @@ -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]+$/; +} diff --git a/t/50_foreign_key_info.t b/t/50_foreign_key_info.t index 73f3f93..a719f30 100644 --- a/t/50_foreign_key_info.t +++ b/t/50_foreign_key_info.t @@ -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'); diff --git a/t/51_table_column_metadata.t b/t/51_table_column_metadata.t index 360b8c4..831d69c 100644 --- a/t/51_table_column_metadata.t +++ b/t/51_table_column_metadata.t @@ -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"; + } +} diff --git a/t/52_db_filename.t b/t/52_db_filename.t index 2e746e1..32acc10 100644 --- a/t/52_db_filename.t +++ b/t/52_db_filename.t @@ -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'); +} diff --git a/t/53_status.t b/t/53_status.t index 42c41b2..a6ab112 100644 --- a/t/53_status.t +++ b/t/53_status.t @@ -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"; + } + } +} diff --git a/t/54_literal_txn.t b/t/54_literal_txn.t index 76d9f74..7c82c2e 100644 --- a/t/54_literal_txn.t +++ b/t/54_literal_txn.t @@ -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"'; diff --git a/t/55_statistics_info.t b/t/55_statistics_info.t index 94c2865..ce0fcab 100644 --- a/t/55_statistics_info.t +++ b/t/55_statistics_info.t @@ -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 ); diff --git a/t/62_regexp_multibyte_char_class.t b/t/62_regexp_multibyte_char_class.t index 1832c52..b61d8b7 100644 --- a/t/62_regexp_multibyte_char_class.t +++ b/t/62_regexp_multibyte_char_class.t @@ -45,4 +45,3 @@ foreach my $call_func (@CALL_FUNCS) { note explain $db_match; } } - diff --git a/t/rt_26775_distinct.t b/t/rt_26775_distinct.t index 181fcde..950ef90 100644 --- a/t/rt_26775_distinct.t +++ b/t/rt_26775_distinct.t @@ -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{ diff --git a/t/rt_32889_prepare_cached_reexecute.t b/t/rt_32889_prepare_cached_reexecute.t index 8d9f78b..7c64a0f 100644 --- a/t/rt_32889_prepare_cached_reexecute.t +++ b/t/rt_32889_prepare_cached_reexecute.t @@ -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) diff --git a/t/rt_48393_debug_panic_with_commit.t b/t/rt_48393_debug_panic_with_commit.t index 64f2cd3..bb642f5 100644 --- a/t/rt_48393_debug_panic_with_commit.t +++ b/t/rt_48393_debug_panic_with_commit.t @@ -54,4 +54,3 @@ $sth->execute; # XXX: Panic occurs here when running under the debugger $dbh->commit or die $dbh->errstr; - diff --git a/t/rt_64177_ping_wipes_out_the_errstr.t b/t/rt_64177_ping_wipes_out_the_errstr.t index c121c80..51f4cef 100644 --- a/t/rt_64177_ping_wipes_out_the_errstr.t +++ b/t/rt_64177_ping_wipes_out_the_errstr.t @@ -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"; diff --git a/t/rt_67581_bind_params_mismatch.t b/t/rt_67581_bind_params_mismatch.t index a8600fb..4a57e40 100644 --- a/t/rt_67581_bind_params_mismatch.t +++ b/t/rt_67581_bind_params_mismatch.t @@ -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; +} diff --git a/t/rt_71311_bind_col_and_unicode.t b/t/rt_71311_bind_col_and_unicode.t index d87ee75..36ea300 100644 --- a/t/rt_71311_bind_col_and_unicode.t +++ b/t/rt_71311_bind_col_and_unicode.t @@ -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; +} diff --git a/t/rt_73159_fts_tokenizer_segfault.t b/t/rt_73159_fts_tokenizer_segfault.t index e80798f..7d9f74e 100644 --- a/t/rt_73159_fts_tokenizer_segfault.t +++ b/t/rt_73159_fts_tokenizer_segfault.t @@ -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"; diff --git a/t/rt_77724_primary_key_with_a_whitespace.t b/t/rt_77724_primary_key_with_a_whitespace.t index d149350..8e6138a 100644 --- a/t/rt_77724_primary_key_with_a_whitespace.t +++ b/t/rt_77724_primary_key_with_a_whitespace.t @@ -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; diff --git a/t/rt_78833_utf8_flag_for_column_names.t b/t/rt_78833_utf8_flag_for_column_names.t index cfda629..caf3940 100644 --- a/t/rt_78833_utf8_flag_for_column_names.t +++ b/t/rt_78833_utf8_flag_for_column_names.t @@ -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"; + } + } +} diff --git a/t/rt_81536_multi_column_primary_key_info.t b/t/rt_81536_multi_column_primary_key_info.t index d07e17b..87b9be1 100644 --- a/t/rt_81536_multi_column_primary_key_info.t +++ b/t/rt_81536_multi_column_primary_key_info.t @@ -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'; +} diff --git a/t/rt_96878_fts_contentless_table.t b/t/rt_96878_fts_contentless_table.t index 398c6bb..f2f9e3e 100644 --- a/t/rt_96878_fts_contentless_table.t +++ b/t/rt_96878_fts_contentless_table.t @@ -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"); - diff --git a/t/virtual_table/00_base.t b/t/virtual_table/00_base.t index d7a1426..2b79c21 100644 --- a/t/virtual_table/00_base.t +++ b/t/virtual_table/00_base.t @@ -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; - - - diff --git a/t/virtual_table/01_destroy.t b/t/virtual_table/01_destroy.t index 63a22dc..6412d68 100644 --- a/t/virtual_table/01_destroy.t +++ b/t/virtual_table/01_destroy.t @@ -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; - diff --git a/t/virtual_table/02_find_function.t b/t/virtual_table/02_find_function.t index 6adb08e..c2202d0 100644 --- a/t/virtual_table/02_find_function.t +++ b/t/virtual_table/02_find_function.t @@ -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; - - - diff --git a/t/virtual_table/10_filecontent.t b/t/virtual_table/10_filecontent.t index bba35cf..3684384 100644 --- a/t/virtual_table/10_filecontent.t +++ b/t/virtual_table/10_filecontent.t @@ -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"; - diff --git a/t/virtual_table/11_filecontent_fulltext.t b/t/virtual_table/11_filecontent_fulltext.t index d77292f..6846cd7 100644 --- a/t/virtual_table/11_filecontent_fulltext.t +++ b/t/virtual_table/11_filecontent_fulltext.t @@ -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"); } - diff --git a/t/virtual_table/20_perldata.t b/t/virtual_table/20_perldata.t index 34d3853..b6817b1 100644 --- a/t/virtual_table/20_perldata.t +++ b/t/virtual_table/20_perldata.t @@ -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"; diff --git a/t/virtual_table/21_perldata_charinfo.t b/t/virtual_table/21_perldata_charinfo.t index c2978a7..71381ca 100644 --- a/t/virtual_table/21_perldata_charinfo.t +++ b/t/virtual_table/21_perldata_charinfo.t @@ -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'"; diff --git a/t/virtual_table/rt_99748.t b/t/virtual_table/rt_99748.t index fcccb0f..d78ccd6 100644 --- a/t/virtual_table/rt_99748.t +++ b/t/virtual_table/rt_99748.t @@ -18,7 +18,6 @@ my @interpolation_attempts = ( '$self', ); - # sample data our $perl_rows = [ [1, 2, 'three'],