-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
+use Test::Warn;
+use Test::Exception;
-use SQL::Abstract::Test qw/is_same_sql_bind/;
-
-plan tests => 15;
-
-use_ok('SQL::Abstract');
-
-#LDNOTE: renamed all "bind" into "where" because that's what they are
-
+use SQL::Abstract::Test import => [ qw(is_same_sql dumper) ];
+use SQL::Abstract;
my @handle_tests = (
#1
{
args => {logic => 'OR'},
-# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
-# LDNOTE: modified the line above (changing the test suite!!!) because
-# the test was not consistent with the doc: hashrefs should not be
-# influenced by the current logic, they always mean 'AND'. So
-# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
},
#2
#5
{
args => {cmp => "=", logic => 'or'},
-# LDNOTE idem
-# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
},
#6
#7
{
args => {logic => "or", cmp => "like"},
-# LDNOTE idem
-# stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )'
stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
},
#8
#14
{
args => {convert => "upper"},
-# LDNOTE : modified the test below, because modified the semantics
-# of "e => { '!=', [qw(f g)] }" : generating "e != 'f' OR e != 'g'"
-# is nonsense (will always be true whatever the value of e). Since
-# this is a 'negative' operator, we must apply the Morgan laws and
-# interpret it as "e != 'f' AND e != 'g'" (and actually the user
-# should rather write "e => {-not_in => [qw/f g/]}".
-
-# stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
- stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) AND ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
- where => [ { ticket => [11, 12, 13],
+ stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
+ where => [ { ticket => [11, 12, 13],
hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
{ tack => { between => [qw/tick tock/] } },
- { a => [qw/b c d/],
- e => { '!=', [qw(f g)] },
+ { a => [qw/b c d/],
+ e => { '!=', [qw(f g)] },
q => { 'not in', [14..20] } } ],
+ warns => qr/\QA multi-element arrayref as an argument to the inequality op '!=' is technically equivalent to an always-true 1=1/,
},
);
for (@handle_tests) {
- local $" = ', ';
- #print "creating a handle with args ($_->{args}): ";
- my $sql = SQL::Abstract->new($_->{args});
- my $where = $_->{where} || { a => 4, b => 0};
- my($stmt, @bind) = $sql->select('test', '*', $where);
+ my $sqla = SQL::Abstract->new($_->{args});
+ my $stmt;
+ lives_ok(sub {
+ (warnings_exist {
+ $stmt = $sqla->select(
+ 'test',
+ '*',
+ $_->{where} || { a => 4, b => 0}
+ );
+ } $_->{warns} || []) || diag dumper($_);
+ }) or diag dumper({ %$_, threw => $@ });
- # LDNOTE: this original test suite from NWIGER did no comparisons
- # on @bind values, just checking if @bind is nonempty.
- # So here we just fake a [1] bind value for the comparison.
- is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
+ is_same_sql($stmt, $_->{stmt});
}
-
+done_testing;