1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00

use more test utility functions

This commit is contained in:
Kenichi Ishigaki 2019-01-07 03:41:09 +09:00
parent cdb721d162
commit f56689d929
21 changed files with 128 additions and 110 deletions

View file

@ -6,13 +6,10 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { requires_unicode_support() }
# #
# Include std stuff # Include std stuff
# #

View file

@ -1,17 +1,14 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok dies @CALL_FUNCS/; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
use Encode qw/decode/; use Encode qw/decode/;
use DBD::SQLite; use DBD::SQLite;
BEGIN { requires_unicode_support(); }
BEGIN { BEGIN {
# Sadly perl for windows (and probably sqlite, too) may hang # Sadly perl for windows (and probably sqlite, too) may hang
# if the system locale doesn't support european languages. # if the system locale doesn't support european languages.

View file

@ -6,15 +6,12 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
use File::Temp (); use File::Temp ();
use File::Spec::Functions ':ALL'; use File::Spec::Functions ':ALL';
BEGIN { requires_unicode_support() }
my $dir = File::Temp::tempdir( CLEANUP => 1 ); my $dir = File::Temp::tempdir( CLEANUP => 1 );
foreach my $subdir ( 'longascii', 'adatbázis', 'name with spaces', '¿¿¿ ¿¿¿¿¿¿') { foreach my $subdir ( 'longascii', 'adatbázis', 'name with spaces', '¿¿¿ ¿¿¿¿¿¿') {
if ($^O eq 'cygwin') { if ($^O eq 'cygwin') {

View file

@ -1,7 +1,7 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/; use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings; use Test::FailWarnings;
@ -68,7 +68,7 @@ foreach my $call_func (@CALL_FUNCS) {
# a commit hook that rejects the transaction # a commit hook that rejects the transaction
$dbh->$call_func(sub {return 1}, "commit_hook"); $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: $@" ); ok ($@, "transaction was rejected: $@" );
# no explicit rollback, because SQLite already did it # 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 # try transaction again .. rollback hook should not be called
$n_rollbacks = 0; $n_rollbacks = 0;
eval {do_transaction($dbh)}; allow_warnings { eval {do_transaction($dbh)} };
is($n_rollbacks, 0, "rollback hook unregistered"); is($n_rollbacks, 0, "rollback hook unregistered");
# check that the rollbacks did really occur # check that the rollbacks did really occur
@ -111,7 +111,7 @@ foreach my $call_func (@CALL_FUNCS) {
"args to authorizer (INSERT)"); "args to authorizer (INSERT)");
# try a delete (should be unauthorized) # 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 $@"); ok($@, "delete was rejected with message $@");
is_deeply(\@authorizer_args, is_deeply(\@authorizer_args,
[DBD::SQLite::DELETE, 'hook_test', undef, 'temp', undef], [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 # unregister the authorizer ... now DELETE should be authorized
$dbh->$call_func(undef, "set_authorizer"); $dbh->$call_func(undef, "set_authorizer");
eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")}; allow_warnings { eval {$dbh->do("DELETE FROM hook_test WHERE foo = 'auth_test'")} };
ok(!$@, "delete was accepted"); ok(!$@, "delete was accepted");
} }

View file

@ -1,7 +1,7 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/; use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings; use Test::FailWarnings;
@ -14,12 +14,7 @@ my @words = qw{
}; };
my @regexes = qw( ^b\\w+ (?i:^b\\w+) ); my @regexes = qw( ^b\\w+ (?i:^b\\w+) );
BEGIN { BEGIN { requires_unicode_support() }
if ($] < 5.008005) {
plan skip_all => 'Unicode is not supported before 5.8.5';
}
}
BEGIN { BEGIN {
# Sadly perl for windows (and probably sqlite, too) may hang # Sadly perl for windows (and probably sqlite, too) may hang
# if the system locale doesn't support european languages. # if the system locale doesn't support european languages.

View file

@ -1,7 +1,7 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok has_sqlite/; use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings; use Test::FailWarnings;
use DBD::SQLite; use DBD::SQLite;
@ -24,13 +24,12 @@ my @tests = (
); );
BEGIN { BEGIN {
if ($] < 5.008005) { requires_unicode_support();
plan skip_all => 'Unicode is not supported before 5.8.5';
if (!has_fts()) {
plan skip_all => 'FTS is disabled for this DBD::SQLite';
} }
if (!grep /ENABLE_FTS3/, 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 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'; plan skip_all => 'FTS3 tokenizer is disabled for this DBD::SQLite';
} }
} }
@ -94,8 +93,7 @@ for my $use_unicode (0, 1) {
SKIP: { SKIP: {
skip "These tests require SQLite compiled with " skip "These tests require SQLite compiled with "
. "ENABLE_FTS3_PARENTHESIS option", scalar @tests . "ENABLE_FTS3_PARENTHESIS option", scalar @tests
unless DBD::SQLite->can('compile_options') && unless has_compile_option('ENABLE_FTS3_PARENTHESIS');
grep /ENABLE_FTS3_PARENTHESIS/, DBD::SQLite::compile_options();
my $sql = "SELECT docid FROM try_$fts WHERE content MATCH ?"; my $sql = "SELECT docid FROM try_$fts WHERE content MATCH ?";

View file

@ -3,8 +3,13 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
use DBD::SQLite; use Test::FailWarnings;
use Data::Dumper;
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 # NOTE: It seems to be better to compare rounded values
# because stored coordinate values may have slight errors # because stored coordinate values may have slight errors
@ -47,13 +52,6 @@ my @test_results = (
[1, 3, 5, 6] [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 # connect
my $dbh = connect_ok( RaiseError => 1 ); my $dbh = connect_ok( RaiseError => 1 );

View file

@ -1,18 +1,16 @@
use strict; use strict;
use warnings; use warnings;
use DBD::SQLite; use lib "t/lib";
use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings;
BEGIN { 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"; 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) { for my $call_func (@CALL_FUNCS) {
my $dbh = connect_ok(RaiseError => 1); my $dbh = connect_ok(RaiseError => 1);
$dbh->do('create table foo (id integer primary key autoincrement, "name space", unique_col integer unique)'); $dbh->do('create table foo (id integer primary key autoincrement, "name space", unique_col integer unique)');

View file

@ -1,15 +1,12 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
if ($] < 5.008005) {
plan skip_all => 'Unicode is not supported before 5.8.5';
}
}
#use Test::FailWarnings; # see RT#112220 #use Test::FailWarnings; # see RT#112220
BEGIN { requires_unicode_support() }
# special case for multibyte (non-ASCII) character class, # special case for multibyte (non-ASCII) character class,
# which only works correctly under the unicode mode # 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}"); # テスト テント 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}"); # テスト テント

View file

@ -8,7 +8,11 @@ use File::Spec ();
use Test::More (); use Test::More ();
our @ISA = 'Exporter'; 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 @CALL_FUNCS;
our $sqlite_call; our $sqlite_call;
@ -137,6 +141,40 @@ $sqlite_call = sub {
$CALL_FUNCS[-1]->($dbh, @_, $func_to_call); $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 =head2 has_sqlite
has_sqlite('3.6.11'); 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; 1;

View file

@ -3,13 +3,10 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { requires_unicode_support(); }
my $dbh = connect_ok( sqlite_unicode => 1 ); my $dbh = connect_ok( sqlite_unicode => 1 );
is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' ); is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' );

View file

@ -1,15 +1,12 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok @CALL_FUNCS/; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { requires_unicode_support() }
foreach my $call_func (@CALL_FUNCS) { foreach my $call_func (@CALL_FUNCS) {
my $dbh = connect_ok( sqlite_unicode => 1 ); my $dbh = connect_ok( sqlite_unicode => 1 );
ok($dbh->$call_func( "perl_uc", 1, \&perl_uc, "create_function" )); ok($dbh->$call_func( "perl_uc", 1, \&perl_uc, "create_function" ));

View file

@ -7,7 +7,7 @@ use DBD::SQLite;
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { 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"; plan skip_all => "Column metadata is disabled for this DBD::SQLite";
} }
} }

View file

@ -5,14 +5,8 @@ use SQLiteTest;
use Test::More; use Test::More;
BEGIN { BEGIN {
use DBD::SQLite; requires_sqlite('3.6.6');
unless ($DBD::SQLite::sqlite_version_number && $DBD::SQLite::sqlite_version_number >= 3006006) { plan skip_all => "FTS is disabled for this DBD::SQLite" unless has_fts();
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";
}
} }
use Test::FailWarnings; use Test::FailWarnings;

View file

@ -4,9 +4,7 @@ use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN { BEGIN {
require DBD::SQLite; unless (has_compile_option('ENABLE_ICU')) {
unless (DBD::SQLite->can('compile_options')
&& grep /ENABLE_ICU/, DBD::SQLite::compile_options()) {
plan( skip_all => 'requires SQLite ICU plugin to be enabled' ); plan( skip_all => 'requires SQLite ICU plugin to be enabled' );
} }
} }

View file

@ -1,16 +1,13 @@
use strict; use strict;
use warnings; use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok/; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
use DBI qw/:sql_types/; use DBI qw/:sql_types/;
BEGIN{ requires_unicode_support(); }
my $dbh = connect_ok(sqlite_unicode => 1); my $dbh = connect_ok(sqlite_unicode => 1);
$dbh->do('create table test1 (id integer, b blob)'); $dbh->do('create table test1 (id integer, b blob)');

View file

@ -3,15 +3,11 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
use Encode; use Encode;
BEGIN { requires_unicode_support() }
unicode_test("\x{263A}"); # (decoded) smiley character unicode_test("\x{263A}"); # (decoded) smiley character
unicode_test("\x{0100}"); # (decoded) capital A with macron unicode_test("\x{0100}"); # (decoded) capital A with macron

View file

@ -7,13 +7,10 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
BEGIN {
unless ( $] >= 5.008005 ) {
plan( skip_all => 'Unicode is not supported before 5.8.5' );
}
}
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { requires_unicode_support() }
my $dbh = connect_ok( sqlite_unicode => 1 ); my $dbh = connect_ok( sqlite_unicode => 1 );
is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' ); is( $dbh->{sqlite_unicode}, 1, 'Unicode is on' );

View file

@ -9,12 +9,11 @@ use warnings;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest; use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings;
use DBI qw/SQL_INTEGER/;
BEGIN { requires_sqlite('3.7.9') } 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() } BEGIN { plan skip_all => 'FTS is disabled for this DBD::SQLite' unless has_fts() }
use DBI qw/SQL_INTEGER/;
use Test::FailWarnings;
my $dbh = connect_ok(RaiseError => 1, AutoCommit => 1); my $dbh = connect_ok(RaiseError => 1, AutoCommit => 1);

View file

@ -6,7 +6,7 @@ use Test::More;
use Test::FailWarnings; use Test::FailWarnings;
BEGIN { requires_sqlite('3.7.7') } 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); my $dbh = connect_ok(AutoCommit => 0);

View file

@ -1,18 +1,17 @@
use strict; use strict;
use warnings; use warnings;
use FindBin;
use lib "t/lib"; use lib "t/lib";
use SQLiteTest qw/connect_ok $sqlite_call requires_sqlite/; use SQLiteTest;
use Test::More; use Test::More;
use Test::FailWarnings;
BEGIN { requires_sqlite('3.7.12') } BEGIN { requires_sqlite('3.7.12') }
use FindBin;
BEGIN { BEGIN {
plan skip_all => "\$FindBin::Bin points to a nonexistent path for some reason: $FindBin::Bin" if !-d $FindBin::Bin; 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"; my $dbfile = "tmp.sqlite";
@ -35,7 +34,7 @@ my @tests = (
# The last set of tests tries to use enhanced query syntax. But when # 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 # SQLite is compiled without it's support, the word 'AND' is taken
# literally. # literally.
if (grep /ENABLE_FTS3_PARENTHESIS/, DBD::SQLite::compile_options()) { if (has_compile_option('ENABLE_FTS3_PARENTHESIS')) {
push @tests, ( push @tests, (
['"use strict" AND "use warnings"' => qw[inc/Test/FailWarnings.pm ['"use strict" AND "use warnings"' => qw[inc/Test/FailWarnings.pm
lib/DBD/SQLite/Constants.pm lib/DBD/SQLite/Constants.pm