Imported from /srv/lorry/lorry-area/perl-dbd-sqlite-tarball/DBD-SQLite-1.38_01.tar.gz.HEADDBD-SQLite-1.38_01masterbaserock/morph

1 files changed, 89 insertions, 0 deletions

diff --git a/t/37_regexp.t b/t/37_regexp.t
new file mode 100644
index 0000000..8936c2a
--- /dev/null
+++ b/t/37_regexp.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test     qw/connect_ok @CALL_FUNCS/;
+use Test::More;
+
+my @words = qw{
+	berger Bergère bergère Bergere
+	HOT hôte 
+	hétéroclite hétaïre hêtre héraut
+	HAT hâter 
+	fétu fête fève ferme
+     };
+my @regexes = qw(  ^b\\w+ (?i:^b\\w+) );
+
+BEGIN {
+	if ($] < 5.008005) {
+		plan skip_all => 'Unicode is not supported before 5.8.5';
+	}
+}
+use Test::NoWarnings;
+
+plan tests => 2 * (3 + 2 * @regexes) * @CALL_FUNCS + 1;
+
+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;
+
+
+
+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;
+    if ($use_unicode) {
+      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");
+    }
+  }
+}
+