1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
use strict;
use warnings;
no if $] >= 5.022, "warnings", "locale";
use lib "t/lib";
use SQLiteTest;
use Test::More;
use if -d ".git", "Test::FailWarnings";
my @words = qw{
berger Bergre bergre Bergere
HOT hte
htroclite htare htre hraut
HAT hter
ftu fte fve ferme
};
my @regexes = qw( ^b\\w+ (?i:^b\\w+) );
BEGIN { requires_unicode_support() }
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;
use DBD::SQLite;
use DBD::SQLite::Constants ':dbd_sqlite_string_mode';
foreach my $call_func (@CALL_FUNCS) {
for my $string_mode (DBD_SQLITE_STRING_MODE_BYTES, DBD_SQLITE_STRING_MODE_UNICODE_STRICT) {
# connect
my $dbh = connect_ok( RaiseError => 1, sqlite_string_mode => $string_mode );
# The following tests are about ordering, so don't reverse!
if ($dbh->selectrow_array('PRAGMA reverse_unordered_selects')) {
$dbh->do('PRAGMA reverse_unordered_selects = OFF');
}
# populate test data
my @vals = @words;
if ($string_mode == DBD_SQLITE_STRING_MODE_BYTES) {
utf8::upgrade($_) foreach @vals;
}
$dbh->do( 'CREATE TEMP TABLE regexp_test ( txt )' );
$dbh->do( "INSERT INTO regexp_test VALUES ( '$_' )" ) foreach @vals;
foreach my $regex (@regexes) {
my @perl_match = grep {/$regex/} @vals;
my $sql = "SELECT txt from regexp_test WHERE txt REGEXP '$regex' "
. "COLLATE perllocale";
my $db_match = $dbh->selectcol_arrayref($sql);
is_deeply(\@perl_match, $db_match, "REGEXP '$regex'");
my @perl_antimatch = grep {!/$regex/} @vals;
$sql =~ s/REGEXP/NOT REGEXP/;
my $db_antimatch = $dbh->selectcol_arrayref($sql);
is_deeply(\@perl_antimatch, $db_antimatch, "NOT REGEXP '$regex'");
}
# null
{
my $sql = "SELECT txt from regexp_test WHERE txt REGEXP NULL "
. "COLLATE perllocale";
my $db_match = $dbh->selectcol_arrayref($sql);
is_deeply([], $db_match, "REGEXP NULL");
$sql =~ s/REGEXP/NOT REGEXP/;
my $db_antimatch = $dbh->selectcol_arrayref($sql);
is_deeply([], $db_antimatch, "NOT REGEXP NULL");
}
}
}
done_testing;
|
