diff --git a/t/12_unicode.t b/t/12_unicode.t index 4688289..a1f616f 100644 --- a/t/12_unicode.t +++ b/t/12_unicode.t @@ -6,13 +6,10 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; +BEGIN { requires_unicode_support() } + # # Include std stuff # diff --git a/t/13_create_collation.t b/t/13_create_collation.t index a635dca..c5fd9b7 100644 --- a/t/13_create_collation.t +++ b/t/13_create_collation.t @@ -1,17 +1,14 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok dies @CALL_FUNCS/; +use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; use Encode qw/decode/; use DBD::SQLite; +BEGIN { requires_unicode_support(); } + BEGIN { # Sadly perl for windows (and probably sqlite, too) may hang # if the system locale doesn't support european languages. diff --git a/t/33_non_latin_path.t b/t/33_non_latin_path.t index bf079a9..d60b7a1 100644 --- a/t/33_non_latin_path.t +++ b/t/33_non_latin_path.t @@ -6,15 +6,12 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; use File::Temp (); use File::Spec::Functions ':ALL'; +BEGIN { requires_unicode_support() } + my $dir = File::Temp::tempdir( CLEANUP => 1 ); foreach my $subdir ( 'longascii', 'adatbázis', 'name with spaces', '¿¿¿ ¿¿¿¿¿¿') { if ($^O eq 'cygwin') { diff --git a/t/36_hooks.t b/t/36_hooks.t index c7ef7ed..e036947 100644 --- a/t/36_hooks.t +++ b/t/36_hooks.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok @CALL_FUNCS/; +use SQLiteTest; use Test::More; use Test::FailWarnings; @@ -68,7 +68,7 @@ foreach my $call_func (@CALL_FUNCS) { # a commit hook that rejects the transaction $dbh->$call_func(sub {return 1}, "commit_hook"); - eval {do_transaction($dbh)}; # in eval() because of RaiseError + allow_warnings { eval {do_transaction($dbh)} }; # in eval() because of RaiseError ok ($@, "transaction was rejected: $@" ); # no explicit rollback, because SQLite already did it @@ -85,7 +85,7 @@ foreach my $call_func (@CALL_FUNCS) { # try transaction again .. rollback hook should not be called $n_rollbacks = 0; - eval {do_transaction($dbh)}; + allow_warnings { eval {do_transaction($dbh)} }; is($n_rollbacks, 0, "rollback hook unregistered"); # check that the rollbacks did really occur @@ -111,7 +111,7 @@ foreach my $call_func (@CALL_FUNCS) { "args to authorizer (INSERT)"); # try a delete (should be unauthorized) - eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")}; + allow_warnings { eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")} }; ok($@, "delete was rejected with message $@"); is_deeply(\@authorizer_args, [DBD::SQLite::DELETE, 'hook_test', undef, 'temp', undef], @@ -119,7 +119,7 @@ foreach my $call_func (@CALL_FUNCS) { # 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'")}; + allow_warnings { eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")} }; ok(!$@, "delete was accepted"); } diff --git a/t/37_regexp.t b/t/37_regexp.t index 89debd2..d7dc3a1 100644 --- a/t/37_regexp.t +++ b/t/37_regexp.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok @CALL_FUNCS/; +use SQLiteTest; use Test::More; use Test::FailWarnings; @@ -14,12 +14,7 @@ my @words = qw{ }; my @regexes = qw( ^b\\w+ (?i:^b\\w+) ); -BEGIN { - if ($] < 5.008005) { - plan skip_all => 'Unicode is not supported before 5.8.5'; - } -} - +BEGIN { requires_unicode_support() } BEGIN { # Sadly perl for windows (and probably sqlite, too) may hang # if the system locale doesn't support european languages. diff --git a/t/43_fts3.t b/t/43_fts3.t index ad36cb4..098fa65 100644 --- a/t/43_fts3.t +++ b/t/43_fts3.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok has_sqlite/; +use SQLiteTest; use Test::More; use Test::FailWarnings; use DBD::SQLite; @@ -24,13 +24,12 @@ my @tests = ( ); BEGIN { - if ($] < 5.008005) { - plan skip_all => 'Unicode is not supported before 5.8.5'; + requires_unicode_support(); + + if (!has_fts()) { + plan skip_all => 'FTS is disabled for this DBD::SQLite'; } - 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()) { + if ($DBD::SQLite::sqlite_version_number >= 3011000 and $DBD::SQLite::sqlite_version_number < 3012000 and !has_compile_option('ENABLE_FTS3_TOKENIZER')) { plan skip_all => 'FTS3 tokenizer is disabled for this DBD::SQLite'; } } @@ -94,8 +93,7 @@ for my $use_unicode (0, 1) { 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(); + unless has_compile_option('ENABLE_FTS3_PARENTHESIS'); my $sql = "SELECT docid FROM try_$fts WHERE content MATCH ?"; diff --git a/t/44_rtree.t b/t/44_rtree.t index 0a3d764..9787844 100644 --- a/t/44_rtree.t +++ b/t/44_rtree.t @@ -3,8 +3,13 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; -use DBD::SQLite; -use Data::Dumper; +use Test::FailWarnings; + +BEGIN { + if (!has_compile_option('ENABLE_RTREE')) { + plan skip_all => 'RTREE is disabled for this DBD::SQLite'; + } +} # NOTE: It seems to be better to compare rounded values # because stored coordinate values may have slight errors @@ -47,13 +52,6 @@ my @test_results = ( [1, 3, 5, 6] ); -BEGIN { - if (!grep /ENABLE_RTREE/, DBD::SQLite::compile_options()) { - plan skip_all => 'RTREE is disabled for this DBD::SQLite'; - } -} -use Test::FailWarnings; - # connect my $dbh = connect_ok( RaiseError => 1 ); diff --git a/t/51_table_column_metadata.t b/t/51_table_column_metadata.t index 21b73b2..4312e41 100644 --- a/t/51_table_column_metadata.t +++ b/t/51_table_column_metadata.t @@ -1,18 +1,16 @@ use strict; use warnings; -use DBD::SQLite; +use lib "t/lib"; +use SQLiteTest; use Test::More; +use Test::FailWarnings; BEGIN { - if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) { + if (!has_compile_option('ENABLE_COLUMN_METADATA')) { plan skip_all => "Column metadata is disabled for this DBD::SQLite"; } } -use lib "t/lib"; -use SQLiteTest qw/connect_ok @CALL_FUNCS/; -use Test::FailWarnings; - 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)'); diff --git a/t/62_regexp_multibyte_char_class.t b/t/62_regexp_multibyte_char_class.t index eaf8bf8..99f4308 100644 --- a/t/62_regexp_multibyte_char_class.t +++ b/t/62_regexp_multibyte_char_class.t @@ -1,15 +1,12 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok @CALL_FUNCS/; +use SQLiteTest; use Test::More; -BEGIN { - if ($] < 5.008005) { - plan skip_all => 'Unicode is not supported before 5.8.5'; - } -} #use Test::FailWarnings; # see RT#112220 +BEGIN { requires_unicode_support() } + # special case for multibyte (non-ASCII) character class, # which only works correctly under the unicode mode my @words = ("\x{e3}\x{83}\x{86}\x{e3}\x{82}\x{b9}\x{e3}\x{83}\x{88}", "\x{e3}\x{83}\x{86}\x{e3}\x{83}\x{b3}\x{e3}\x{83}\x{88}"); # テスト テント diff --git a/t/lib/SQLiteTest.pm b/t/lib/SQLiteTest.pm index a013b42..ad46ecd 100644 --- a/t/lib/SQLiteTest.pm +++ b/t/lib/SQLiteTest.pm @@ -8,7 +8,11 @@ use File::Spec (); use Test::More (); our @ISA = 'Exporter'; -our @EXPORT = qw/connect_ok dies dbfile @CALL_FUNCS $sqlite_call has_sqlite requires_sqlite/; +our @EXPORT = qw/ + connect_ok dies dbfile @CALL_FUNCS $sqlite_call + has_sqlite requires_sqlite requires_unicode_support + allow_warnings has_compile_option has_fts +/; our @CALL_FUNCS; our $sqlite_call; @@ -137,6 +141,40 @@ $sqlite_call = sub { $CALL_FUNCS[-1]->($dbh, @_, $func_to_call); }; +=head2 has_compile_option + + has_compile_option('ENABLE_FTS3'); + has_compile_option(qr/^ENABLE_FTS[345]/); + +returns true if DBD::SQLite is built with a specified compile option. + +=cut + +sub has_compile_option { + my $option = shift; + require DBD::SQLite; + return unless DBD::SQLite->can('compile_options'); + my $re = ref $option eq ref qr// ? $option : qr/\b$option\b/; + grep /$re/, DBD::SQLite::compile_options(); +} + +=head2 has_fts + + has_fts(); + has_fts(3); + +returns true if DBD::SQLite is built with FTS. + +=cut + +sub has_fts { + if (my $version = shift) { + has_compile_option("ENABLE_FTS$version"); + } else { + has_compile_option(qr/\bENABLE_FTS\d\b/); + } +} + =head2 has_sqlite has_sqlite('3.6.11'); @@ -170,4 +208,33 @@ sub requires_sqlite { } } +=head2 requires_unicode_support + + BEGIN { requires_unicode_support(); } + +skips all the tests if Perl does not have sane Unicode support. + +=cut + +sub requires_unicode_support { + unless ($] >= 5.008005) { + Test::More::plan skip_all => "Unicode is not supported before 5.8.5"; + exit; + } +} + +=head2 allow_warnings + + allow_warnings { eval {...} }; + +hides SQLite warnings from Test::FailWarnings. + +=cut + +sub allow_warnings (&) { + my $code = shift; + local $SIG{__WARN__} = sub { Test::More::note @_ }; + $code->(); +} + 1; diff --git a/t/rt_25371_asymmetric_unicode.t b/t/rt_25371_asymmetric_unicode.t index 09dca60..711c5ed 100644 --- a/t/rt_25371_asymmetric_unicode.t +++ b/t/rt_25371_asymmetric_unicode.t @@ -3,13 +3,10 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; +BEGIN { requires_unicode_support(); } + my $dbh = connect_ok( sqlite_unicode => 1 ); is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' ); diff --git a/t/rt_25924_user_defined_func_unicode.t b/t/rt_25924_user_defined_func_unicode.t index 880fc2d..20bafcd 100644 --- a/t/rt_25924_user_defined_func_unicode.t +++ b/t/rt_25924_user_defined_func_unicode.t @@ -1,15 +1,12 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok @CALL_FUNCS/; +use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; +BEGIN { requires_unicode_support() } + foreach my $call_func (@CALL_FUNCS) { my $dbh = connect_ok( sqlite_unicode => 1 ); ok($dbh->$call_func( "perl_uc", 1, \&perl_uc, "create_function" )); diff --git a/t/rt_40594_nullable.t b/t/rt_40594_nullable.t index c9bf082..5477502 100644 --- a/t/rt_40594_nullable.t +++ b/t/rt_40594_nullable.t @@ -7,7 +7,7 @@ use DBD::SQLite; use Test::FailWarnings; BEGIN { - if (!grep /^ENABLE_COLUMN_METADATA/, DBD::SQLite::compile_options()) { + if (!has_compile_option('ENABLE_COLUMN_METADATA')) { plan skip_all => "Column metadata is disabled for this DBD::SQLite"; } } diff --git a/t/rt_50503_fts3.t b/t/rt_50503_fts3.t index 134a3b5..55750bb 100644 --- a/t/rt_50503_fts3.t +++ b/t/rt_50503_fts3.t @@ -5,14 +5,8 @@ use SQLiteTest; use Test::More; BEGIN { - use DBD::SQLite; - unless ($DBD::SQLite::sqlite_version_number && $DBD::SQLite::sqlite_version_number >= 3006006) { - plan skip_all => "this test requires SQLite 3.6.6 and newer"; - exit; - } - if (!grep /^ENABLE_FTS3/, DBD::SQLite::compile_options()) { - plan skip_all => "FTS3 is disabled for this DBD::SQLite"; - } + requires_sqlite('3.6.6'); + plan skip_all => "FTS is disabled for this DBD::SQLite" unless has_fts(); } use Test::FailWarnings; diff --git a/t/rt_53235_icu_compatibility.t b/t/rt_53235_icu_compatibility.t index 139ccd3..63ec8ea 100644 --- a/t/rt_53235_icu_compatibility.t +++ b/t/rt_53235_icu_compatibility.t @@ -4,9 +4,7 @@ use lib "t/lib"; use SQLiteTest; use Test::More; BEGIN { - require DBD::SQLite; - unless (DBD::SQLite->can('compile_options') - && grep /ENABLE_ICU/, DBD::SQLite::compile_options()) { + unless (has_compile_option('ENABLE_ICU')) { plan( skip_all => 'requires SQLite ICU plugin to be enabled' ); } } diff --git a/t/rt_71311_bind_col_and_unicode.t b/t/rt_71311_bind_col_and_unicode.t index a4ba485..44e85b6 100644 --- a/t/rt_71311_bind_col_and_unicode.t +++ b/t/rt_71311_bind_col_and_unicode.t @@ -1,16 +1,13 @@ use strict; use warnings; use lib "t/lib"; -use SQLiteTest qw/connect_ok/; +use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; use DBI qw/:sql_types/; +BEGIN{ requires_unicode_support(); } + my $dbh = connect_ok(sqlite_unicode => 1); $dbh->do('create table test1 (id integer, b blob)'); diff --git a/t/rt_78833_utf8_flag_for_column_names.t b/t/rt_78833_utf8_flag_for_column_names.t index 909572a..39d3f52 100644 --- a/t/rt_78833_utf8_flag_for_column_names.t +++ b/t/rt_78833_utf8_flag_for_column_names.t @@ -3,15 +3,11 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; - -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; use Encode; +BEGIN { requires_unicode_support() } + unicode_test("\x{263A}"); # (decoded) smiley character unicode_test("\x{0100}"); # (decoded) capital A with macron diff --git a/t/rt_96877_unicode_statements.t b/t/rt_96877_unicode_statements.t index 4724191..c07f1b3 100644 --- a/t/rt_96877_unicode_statements.t +++ b/t/rt_96877_unicode_statements.t @@ -7,13 +7,10 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; -BEGIN { - unless ( $] >= 5.008005 ) { - plan( skip_all => 'Unicode is not supported before 5.8.5' ); - } -} use Test::FailWarnings; +BEGIN { requires_unicode_support() } + my $dbh = connect_ok( sqlite_unicode => 1 ); is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' ); diff --git a/t/rt_96878_fts_contentless_table.t b/t/rt_96878_fts_contentless_table.t index b43016e..194b0b9 100644 --- a/t/rt_96878_fts_contentless_table.t +++ b/t/rt_96878_fts_contentless_table.t @@ -9,12 +9,11 @@ use warnings; use lib "t/lib"; use SQLiteTest; use Test::More; +use Test::FailWarnings; +use DBI qw/SQL_INTEGER/; BEGIN { requires_sqlite('3.7.9') } -BEGIN { plan skip_all => 'FTS3 is disabled for this DBD::SQLite' if !grep /ENABLE_FTS3/, DBD::SQLite::compile_options() } - -use DBI qw/SQL_INTEGER/; -use Test::FailWarnings; +BEGIN { plan skip_all => 'FTS is disabled for this DBD::SQLite' unless has_fts() } my $dbh = connect_ok(RaiseError => 1, AutoCommit => 1); diff --git a/t/rt_97598_crash_on_disconnect_with_virtual_tables.t b/t/rt_97598_crash_on_disconnect_with_virtual_tables.t index d731e2b..ea2c836 100644 --- a/t/rt_97598_crash_on_disconnect_with_virtual_tables.t +++ b/t/rt_97598_crash_on_disconnect_with_virtual_tables.t @@ -6,7 +6,7 @@ use Test::More; use Test::FailWarnings; BEGIN { requires_sqlite('3.7.7') } -BEGIN { plan skip_all => 'FTS3 is disabled for this DBD::SQLite' if !grep /ENABLE_FTS3/, DBD::SQLite::compile_options() } +BEGIN { plan skip_all => 'FTS is disabled for this DBD::SQLite' unless has_fts() } my $dbh = connect_ok(AutoCommit => 0); diff --git a/t/virtual_table/11_filecontent_fulltext.t b/t/virtual_table/11_filecontent_fulltext.t index afcc36a..4aacf00 100644 --- a/t/virtual_table/11_filecontent_fulltext.t +++ b/t/virtual_table/11_filecontent_fulltext.t @@ -1,18 +1,17 @@ use strict; use warnings; +use FindBin; use lib "t/lib"; -use SQLiteTest qw/connect_ok $sqlite_call requires_sqlite/; +use SQLiteTest; use Test::More; +use Test::FailWarnings; BEGIN { requires_sqlite('3.7.12') } -use FindBin; - BEGIN { plan skip_all => "\$FindBin::Bin points to a nonexistent path for some reason: $FindBin::Bin" if !-d $FindBin::Bin; - plan skip_all => 'FTS is disabled for this DBD::SQLite' if !grep /ENABLE_FTS3/, DBD::SQLite::compile_options(); + plan skip_all => 'FTS is disabled for this DBD::SQLite' unless has_fts(); } -use Test::FailWarnings; my $dbfile = "tmp.sqlite"; @@ -35,7 +34,7 @@ my @tests = ( # The last set of tests tries to use enhanced query syntax. But when # SQLite is compiled without it's support, the word 'AND' is taken # literally. -if (grep /ENABLE_FTS3_PARENTHESIS/, DBD::SQLite::compile_options()) { +if (has_compile_option('ENABLE_FTS3_PARENTHESIS')) { push @tests, ( ['"use strict" AND "use warnings"' => qw[inc/Test/FailWarnings.pm lib/DBD/SQLite/Constants.pm