[libdbd-sqlite3-perl] 11/43: make sure to set internal unicode mode before registering default callbacks (REGEXP function etc)

[Salvatore Bonaccorso]

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 <ishig...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits