1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 06:08:38 -04:00

Handle 'unknown' op in DBD::SQLite::VirtualTable::PerlData

This patch adds code and a test when SQLite generates an 'unknown'
op for a table join in the BEST_INDEX() callback. The Perl code crashed
when such an op was generated for a JOIN criterion by the SQLite engine.

The SQLite engine creates an 'unknown' op on the following SQL
for example:

                select r.nodepath
                  from temp.scan_results r
                       left join temp.scan_results m
                             on r.nodepath = m.nodepath+1
                 where m.nodepath is null

The important part is that the right side of the left join must be
checked for IS NULL.
This commit is contained in:
Max Maischein 2019-01-25 19:05:07 +01:00
parent bfe71db88f
commit 1fd1a0d15f
3 changed files with 95 additions and 1 deletions

View file

@ -138,6 +138,7 @@ t/virtual_table/20_perldata.t
t/virtual_table/21_perldata_charinfo.t
t/virtual_table/rt_124941.t
t/virtual_table/rt_99748.t
t/virtual_table/unknown_op.t
typemap
xt/cpp_comments.t
xt/meta.t

View file

@ -88,7 +88,7 @@ sub BEST_INDEX {
# in FILTER() for deciding which rows match the constraints.
my @conditions;
my $ix = 0;
foreach my $constraint (grep {$_->{usable}} @$constraints) {
foreach my $constraint (grep {$_->{usable} and exists $SQLOP2PERLOP{ $_->{op} } } @$constraints) {
my $col = $constraint->{col};
my ($member, $optype);

View file

@ -0,0 +1,93 @@
#!perl -w
use strict;
use Test::More tests => 4;
our $scan_results = [
{ nodepath => 1 },
{ nodepath => 2 },
{ nodepath => 3 },
];
my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:", '', '',
{RaiseError => 1, AutoCommit => 1});
# register the module
$dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData");
$dbh->do(<<'SQL');
CREATE VIRTUAL TABLE temp.scan_results
USING perl(file varchar,
value varchar,
selector varchar,
nodepath varchar,
expected integer,
preference integer,
complexity integer,
location varchar,
type varchar,
hashrefs="main::scan_results")
SQL
my $ok = eval {
my $sth = $dbh->prepare(<<'SQL');
select distinct r.selector
from temp.scan_results r
left join temp.scan_results m
on r.nodepath = m.nodepath+1
where m.nodepath = 1
SQL
$sth->execute;
#use DBIx::RunSQL; print DBIx::RunSQL->format_results( sth => $sth );
1;
};
is $ok, 1, "We survive a numeric comparison";
undef $ok;
$ok = eval {
my $sth = $dbh->prepare(<<'SQL');
select distinct r.selector
from temp.scan_results r
left join temp.scan_results m
on r.nodepath = m.nodepath+1
where m.nodepath is not null
SQL
$sth->execute;
1;
#use DBIx::RunSQL; print DBIx::RunSQL->format_results( sth => $sth );
};
is $ok, 1, "We survive an isnull comparison";
undef $ok;
$ok = eval {
my $sth = $dbh->prepare(<<'SQL');
select r.nodepath
from temp.scan_results r
left join temp.scan_results m
on r.nodepath = m.nodepath+1
where r.nodepath is null
SQL
$sth->execute;
1;
#use DBIx::RunSQL; print DBIx::RunSQL->format_results( sth => $sth );
};
is $ok, 1, "We survive an isnull comparison on the left side";
undef $ok;
my $sth;
$ok = eval {
$sth = $dbh->prepare(<<'SQL');
select r.nodepath
from temp.scan_results r
left join temp.scan_results m
on r.nodepath = m.nodepath+1
where m.nodepath is null
SQL
$sth->execute;
1;
#use DBIx::RunSQL; print DBIx::RunSQL->format_results( sth => $sth );
};
is $ok, 1, "We survive an isnull comparison on the right side";
undef $ok;
#my $rows = $sth->fetchall_arrayref;
#use Data::Dumper;
#warn Dumper $rows;