[libdbd-sqlite3-perl] 11/43: make sure to set internal unicode mode before registering default callbacks (REGEXP function etc)
Salvatore Bonaccorso
carnil at debian.org
Tue Nov 15 15:27:40 UTC 2016
This is an automated email from the git hooks/post-receive script.
carnil pushed a commit to branch master
in repository libdbd-sqlite3-perl.
commit 7ae3f655d0812a4d79bebc83654a71c5d0ddfa32
Author: Kenichi Ishigaki <ishigaki at cpan.org>
Date: Sat Feb 20 09:45:11 2016 +0900
make sure to set internal unicode mode before registering default callbacks (REGEXP function etc)
---
dbdimp.c | 11 +++++++-
t/62_regexp_multibyte_char_class.t | 56 ++++++++++++++++++++++++++++++++++++++
2 files changed, 66 insertions(+), 1 deletion(-)
diff --git a/dbdimp.c b/dbdimp.c
index 00e959b..a4ee8fe 100644
--- a/dbdimp.c
+++ b/dbdimp.c
@@ -405,6 +405,7 @@ sqlite_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pa
SV **val;
int extended = 0;
int flag = 0;
+ int unicode = 0;
sqlite_trace(dbh, imp_dbh, 3, form("login '%s' (version %s)", dbname, sqlite3_version));
@@ -427,6 +428,14 @@ sqlite_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pa
hv_stores(hv, "ReadOnly", newSViv(1));
}
}
+ /* sqlite_unicode should be detected earlier, to register default functions correctly */
+ if (hv_exists(hv, "sqlite_unicode", 14)) {
+ val = hv_fetch(hv, "sqlite_unicode", 14, 0);
+ unicode = (val && SvOK(*val)) ? SvIV(*val) : 0;
+ } else if (hv_exists(hv, "unicode", 7)) {
+ val = hv_fetch(hv, "unicode", 7, 0);
+ unicode = (val && SvOK(*val)) ? SvIV(*val) : 0;
+ }
}
rc = sqlite_open2(dbname, &(imp_dbh->db), flag, extended);
if ( rc != SQLITE_OK ) {
@@ -434,7 +443,7 @@ sqlite_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pa
}
DBIc_IMPSET_on(imp_dbh);
- imp_dbh->unicode = FALSE;
+ imp_dbh->unicode = unicode;
imp_dbh->functions = newAV();
imp_dbh->aggregates = newAV();
imp_dbh->collation_needed_callback = newSVsv( &PL_sv_undef );
diff --git a/t/62_regexp_multibyte_char_class.t b/t/62_regexp_multibyte_char_class.t
new file mode 100644
index 0000000..5ed5fc9
--- /dev/null
+++ b/t/62_regexp_multibyte_char_class.t
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use t::lib::Test qw/connect_ok @CALL_FUNCS/;
+use Test::More;
+BEGIN {
+ if ($] < 5.008005) {
+ plan skip_all => 'Unicode is not supported before 5.8.5';
+ }
+}
+use Test::NoWarnings;
+
+# special case for multibyte (non-ASCII) character class,
+# which only works correctly under the unicode mode
+my @words = qw{ テスト テント };
+my $regex = 'テ[スン]ト';
+
+
+plan tests => 2 * 2 * @CALL_FUNCS + 1;
+
+foreach my $call_func (@CALL_FUNCS) {
+
+ for my $use_unicode (0, 1) {
+
+ # connect
+ my $dbh = connect_ok( RaiseError => 1, sqlite_unicode => $use_unicode );
+
+ # populate test data
+ my @vals = @words;
+ my $re = $regex;
+ if ($use_unicode) {
+ utf8::decode($_) foreach @vals;
+ utf8::decode($re);
+ }
+
+ $dbh->do( 'CREATE TEMP TABLE regexp_test ( txt )' );
+ $dbh->do( "INSERT INTO regexp_test VALUES ( '$_' )" ) foreach @vals;
+
+ my $sql = "SELECT txt from regexp_test WHERE txt REGEXP '$re' ";
+ my $db_match = $dbh->selectcol_arrayref($sql);
+
+ if ($use_unicode) {
+ is @$db_match => 2;
+ note explain $db_match;
+ } else {
+ is @$db_match => 0;
+ note explain $db_match;
+ }
+ }
+}
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libdbd-sqlite3-perl.git
More information about the Pkg-perl-cvs-commits
mailing list