Fix to use a PV value as a virtual table column value where appropriate (RT-124941)

dbdimp_virtual_table.inc

@@ -47,6 +47,44 @@ static int _call_perl_vtab_method(sqlite3_vtab *pVTab,
 }
 
 
+/* RT-124941: it seems better to prefer PV where appropriate */
+static void
+sqlite_set_result_for_vtable(pTHX_ sqlite3_context *context, SV *result, int is_error)
+{
+    STRLEN len;
+    char *s;
+    sqlite3_int64 iv;
+
+    if ( is_error ) {
+        s = SvPV(result, len);
+        sqlite3_result_error( context, s, len );
+        return;
+    }
+
+    /* warn("result: %s\n", SvPV_nolen(result)); */
+    if ( !SvOK(result) ) {
+        sqlite3_result_null( context );
+    } else if ( SvPOK(result) ) {
+        s = SvPV(result, len);
+        sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
+    } else if( SvIOK_UV(result) ) {
+        if ((UV)(sqlite3_int64)UV_MAX == UV_MAX)
+            sqlite3_result_int64( context, (sqlite3_int64)SvUV(result));
+        else {
+            s = SvPV(result, len);
+            sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
+        }
+    } else if ( !_sqlite_atoi64(SvPV(result, len), &iv) ) {
+        sqlite3_result_int64( context, iv );
+    } else if ( SvNOK(result) && ( sizeof(NV) == sizeof(double) || SvNVX(result) == (double) SvNVX(result) ) ) {
+        sqlite3_result_double( context, SvNV(result));
+    } else {
+        s = SvPV(result, len);
+        sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
+    }
+}
+
+
 
 static int perl_vt_New(const char *method,
                        sqlite3 *db, void *pAux,
@@ -499,7 +537,7 @@ static int perl_vt_Column(sqlite3_vtab_cursor *pVtabCursor,
     }
     else {
         SV *result = POPs;
-        sqlite_set_result(aTHX_ context, result, 0 );
+        sqlite_set_result_for_vtable(aTHX_ context, result, 0 );
         rc = SQLITE_OK;
     }
 

t/virtual_table/rt_124941.t

@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+use strict;
+BEGIN {
+        $|  = 1;
+        $^W = 1;
+}
+
+use lib "t/lib";
+use SQLiteTest qw/connect_ok $sqlite_call has_sqlite/;
+use Test::More tests => 6;
+use Test::NoWarnings;
+
+my $dbh = connect_ok(sqlite_trace => 2);
+# register the module and declare the virtual table
+$dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData");
+
+# create a table, reference_values,  with 2 columns
+# ref_value - a text column which will have strings and numeric data (as text)
+# our_id    - a numeric column with integers
+$dbh->do('DROP TABLE IF EXISTS reference_values');
+$dbh->do('CREATE TABLE reference_values(ref_value text, our_id int)');
+
+my @data_to_insert = (
+    [ 'aaaa', 1 ],
+    [ 'bbbb', 2 ],
+    [ 'cccc', 3 ],
+    [ 'xxxx', 4 ],
+    [ 'yyyy', 5 ],
+    [ '0003', 6 ],
+    [ '1000', 7 ],
+    [ '2222', 8 ],
+    [ '3000', 9 ],
+    [ '4000', 10 ],
+    [ '5abc', 11 ],
+    [ 'a6cd', 12 ],
+    [ 'ab7d', 13 ],
+    [ 'abc8', 14 ],
+    [ '9aaa', 15 ],
+);
+
+my $sth = $dbh->prepare('INSERT INTO reference_values VALUES (?, ?)');
+foreach my $data_aref (@data_to_insert) {
+    $sth->execute(@$data_aref) or die "Couldn't insert data row:" . $dbh->errstr;
+}
+
+# these are data sets that will be used by the virtual perldata function
+# we'll add these as a virtual table then do an inner join on our reference_value
+# table to find matching values
+my $text_column_search_sets = {
+    strings_only  => [ qw( aaaa abcd bbbb bcde cccc yyyy ) ],
+    mixed         => [ qw( aaaa 0003 z8z8 6666 cccc 1000 zzzz 7777 ) ],
+    initial_digit => [ qw( 1aaa 2bbb 5abc 6abc 9aaa 3aaa 1aaa 2aaa ) ],
+    numbers_only  => [ qw( 0001 0003 9999 1000 5555 3000 6666 4000 ) ] ,
+};
+
+my $expected_answers = {
+    strings_only =>
+        [ [ 'aaaa', 1 ], [ 'bbbb', 2 ], [ 'cccc', 3 ], [ 'yyyy', 5 ] ],
+    mixed => [ [ 'aaaa', 1 ], [ 'cccc', 3 ], [ '0003', 6 ], [ '1000', 7 ] ],
+    initial_digit => [ [ '5abc', 11 ], [ '9aaa', 15 ] ],
+    numbers_only =>
+        [ [ '0003', 6 ], [ '1000', 7 ], [ '3000', 9 ], [ '4000', 10 ] ]
+};
+
+our $search_value_set;
+my $temp_table_number = 0;
+
+my @test_order = qw(strings_only mixed initial_digit numbers_only );
+
+foreach my $test_desc (@test_order) {
+
+    $temp_table_number++;
+    my $temp_table_name = 'temp.lookup_values_' . $temp_table_number;
+    $search_value_set    = $text_column_search_sets->{$test_desc};
+note explain $search_value_set;
+
+    my $virt_table_sql =<< "EOT";
+    CREATE VIRTUAL TABLE $temp_table_name
+    USING perl(lookup_value text, colref="main::search_value_set")
+EOT
+
+    $dbh->do($virt_table_sql);
+
+    my $lookup_sql =<< "EOT";
+    select ref_value, our_id from reference_values
+    inner join $temp_table_name
+    on $temp_table_name.lookup_value = reference_values.ref_value
+    order by our_id
+EOT
+
+    my $got_aref = $dbh->selectall_arrayref($lookup_sql);
+    my $expected_aref = $expected_answers->{$test_desc};
+
+    is_deeply($got_aref, $expected_aref, $test_desc);
+}