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:
parent
bfe71db88f
commit
1fd1a0d15f
3 changed files with 95 additions and 1 deletions
1
MANIFEST
1
MANIFEST
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
93
t/virtual_table/unknown_op.t
Normal file
93
t/virtual_table/unknown_op.t
Normal 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;
|
Loading…
Add table
Reference in a new issue