X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F05in_between.t;h=ae66b90b97c7c49ccd9f18c5959ca5b1f76894b0;hb=HEAD;hp=2ae0172ae3cf61aac6e9e24ddf9c7f2fc29016eb;hpb=428975b0e646c0769d7eb530d4f52443471a9a9a;p=scpubgit%2FQ-Branch.git diff --git a/t/05in_between.t b/t/05in_between.t index 2ae0172..ae66b90 100644 --- a/t/05in_between.t +++ b/t/05in_between.t @@ -1,12 +1,10 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; +use Test::Warn; use Test::Exception; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where dumper)]; -use Data::Dumper; use SQL::Abstract; my @in_between_tests = ( @@ -69,7 +67,7 @@ my @in_between_tests = ( ( map { { where => { x => { -between => $_ } }, test => 'invalid -between args', - exception => qr|Operator 'BETWEEN' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref|, + throws => qr|Operator 'BETWEEN' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref|, } } ( [ 1, 2, 3 ], [ 1, undef, 3 ], @@ -95,6 +93,26 @@ my @in_between_tests = ( ] }, }, stmt => "WHERE ( + ( start0 BETWEEN ? AND UPPER(?) ) + AND ( start1 BETWEEN ? AND ? ) + AND ( start2 BETWEEN lower(x) AND upper(y) ) + AND ( start3 BETWEEN lower(x) AND upper(?) ) + )", + bind => [1, 2, 1, 2, 'stuff'], + test => '-between POD test', + }, + { + args => { restore_old_unop_handling => 1 }, + where => { + start0 => { -between => [ 1, { -upper => 2 } ] }, + start1 => { -between => \["? AND ?", 1, 2] }, + start2 => { -between => \"lower(x) AND upper(y)" }, + start3 => { -between => [ + \"lower(x)", + \["upper(?)", 'stuff' ], + ] }, + }, + stmt => "WHERE ( ( start0 BETWEEN ? AND UPPER ? ) AND ( start1 BETWEEN ? AND ? ) AND ( start2 BETWEEN lower(x) AND upper(y) ) @@ -115,6 +133,32 @@ my @in_between_tests = ( ] }, }, stmt => "WHERE ( + ( start0 BETWEEN ? AND UPPER(?) ) + AND ( start1 BETWEEN ? AND ? ) + AND ( start2 BETWEEN lower(x) AND upper(y) ) + AND ( start3 BETWEEN lower(x) AND upper(?) ) + )", + bind => [ + [ start0 => 1 ], + [ start0 => 2 ], + [ start1 => 1 ], + [ start1 => 2 ], + [ start3 => 'stuff' ], + ], + test => '-between POD test', + }, + { + args => { restore_old_unop_handling => 1, bindtype => 'columns' }, + where => { + start0 => { -between => [ 1, { -upper => 2 } ] }, + start1 => { -between => \["? AND ?", [ start1 => 1], [start1 => 2] ] }, + start2 => { -between => \"lower(x) AND upper(y)" }, + start3 => { -between => [ + \"lower(x)", + \["upper(?)", [ start3 => 'stuff'] ], + ] }, + }, + stmt => "WHERE ( ( start0 BETWEEN ? AND UPPER ? ) AND ( start1 BETWEEN ? AND ? ) AND ( start2 BETWEEN lower(x) AND upper(y) ) @@ -129,47 +173,65 @@ my @in_between_tests = ( ], test => '-between POD test', }, + { + where => { 'test1.a' => { 'In', ['boom', 'bang'] } }, + stmt => ' WHERE ( test1.a IN ( ?, ? ) )', + bind => ['boom', 'bang'], + test => 'In (no dash, initial cap) with qualified column', + }, + { + where => { a => { 'between', ['boom', 'bang'] } }, + stmt => ' WHERE ( a BETWEEN ? AND ? )', + bind => ['boom', 'bang'], + test => 'between (no dash) with two placeholders', + }, { - parenthesis_significant => 1, where => { x => { -in => [ 1 .. 3] } }, - stmt => "WHERE ( x IN (?, ?, ?) )", - bind => [ 1 .. 3], + stmt => "WHERE x IN (?, ?, ?)", + bind => [ 1 .. 3 ], test => '-in with an array of scalars', }, { - parenthesis_significant => 1, where => { x => { -in => [] } }, - stmt => "WHERE ( 0=1 )", + stmt => "WHERE 0=1", bind => [], test => '-in with an empty array', }, { - parenthesis_significant => 1, where => { x => { -in => \'( 1,2,lower(y) )' } }, - stmt => "WHERE ( x IN ( 1,2,lower(y) ) )", + stmt => "WHERE x IN ( 1,2,lower(y) )", bind => [], test => '-in with a literal scalarref', }, + + # note that outer parens are opened even though literal was requested below { - parenthesis_significant => 1, where => { x => { -in => \['( ( ?,?,lower(y) ) )', 1, 2] } }, - stmt => "WHERE ( x IN ( ?,?,lower(y) ) )", # note that outer parens are opened even though literal was requested (RIBASUSHI) + stmt => "WHERE x IN ( ?,?,lower(y) )", bind => [1, 2], test => '-in with a literal arrayrefref', }, { - parenthesis_significant => 1, where => { status => { -in => \"(SELECT status_codes\nFROM states)" }, }, - # failed to open outer parens on a multi-line query in 1.61 (semifor) - stmt => " WHERE ( status IN ( SELECT status_codes FROM states )) ", + stmt => " WHERE status IN ( SELECT status_codes FROM states )", bind => [], test => '-in multi-line subquery test', }, + + # check that the outer paren opener is not too agressive + # note: this syntax *is not legal* on SQLite (maybe others) + # see end of https://rt.cpan.org/Ticket/Display.html?id=99503 + { + where => { foo => { -in => \ '(SELECT 1) UNION (SELECT 2)' } }, + stmt => 'WHERE foo IN ( (SELECT 1) UNION (SELECT 2) )', + bind => [], + test => '-in paren-opening works on balanced pairs only', + }, + { - parenthesis_significant => 1, where => { customer => { -in => \[ 'SELECT cust_id FROM cust WHERE balance > ?', @@ -178,22 +240,29 @@ my @in_between_tests = ( status => { -in => \'SELECT status_codes FROM states' }, }, stmt => " - WHERE (( + WHERE customer IN ( SELECT cust_id FROM cust WHERE balance > ? ) AND status IN ( SELECT status_codes FROM states ) - )) ", bind => [2000], test => '-in POD test', }, + { where => { x => { -in => [ \['LOWER(?)', 'A' ], \'LOWER(b)', { -lower => 'c' } ] } }, + stmt => " WHERE ( x IN ( LOWER(?), LOWER(b), LOWER(?) ) )", + bind => [qw/A c/], + test => '-in with an array of function array refs with args', + }, + { + args => { restore_old_unop_handling => 1 }, + where => { x => { -in => [ \['LOWER(?)', 'A' ], \'LOWER(b)', { -lower => 'c' } ] } }, stmt => " WHERE ( x IN ( LOWER(?), LOWER(b), LOWER ? ) )", bind => [qw/A c/], test => '-in with an array of function array refs with args', }, { - exception => qr/ + throws => qr/ \QSQL::Abstract before v1.75 used to generate incorrect SQL \E \Qwhen the -IN operator was given an undef-containing list: \E \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E @@ -206,7 +275,7 @@ my @in_between_tests = ( test => '-in with undef as an element', }, { - exception => qr/ + throws => qr/ \QSQL::Abstract before v1.75 used to generate incorrect SQL \E \Qwhen the -IN operator was given an undef-containing list: \E \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E @@ -218,36 +287,135 @@ my @in_between_tests = ( bind => [ 1, 2, 3 ], test => '-in with multiple undef elements', }, + { + where => { a => { -in => 42 }, b => { -not_in => 42 } }, + stmt => ' WHERE a IN ( ? ) AND b NOT IN ( ? )', + bind => [ 42, 42 ], + test => '-in, -not_in with scalar', + }, + { + where => { a => { -in => [] }, b => { -not_in => [] } }, + stmt => ' WHERE ( 0=1 AND 1=1 )', + bind => [], + test => '-in, -not_in with empty arrays', + }, + { + throws => qr/ + \QSQL::Abstract before v1.75 used to generate incorrect SQL \E + \Qwhen the -IN operator was given an undef-containing list: \E + \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E + \Qversion of SQL::Abstract will emit the logically correct SQL \E + \Qinstead of raising this exception)\E + /x, + where => { a => { -in => [42, undef] }, b => { -not_in => [42, undef] } }, + stmt => ' WHERE ( ( a IN ( ? ) OR a IS NULL ) AND b NOT IN ( ? ) AND b IS NOT NULL )', + bind => [ 42, 42 ], + test => '-in, -not_in with undef among elements', + }, + { + throws => qr/ + \QSQL::Abstract before v1.75 used to generate incorrect SQL \E + \Qwhen the -IN operator was given an undef-containing list: \E + \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E + \Qversion of SQL::Abstract will emit the logically correct SQL \E + \Qinstead of raising this exception)\E + /x, + where => { a => { -in => [undef] }, b => { -not_in => [undef] } }, + stmt => ' WHERE ( a IS NULL AND b IS NOT NULL )', + bind => [], + test => '-in, -not_in with just undef element', + }, + { + where => { a => { -in => undef } }, + throws => qr/Argument passed to the 'IN' operator can not be undefined/, + test => '-in with undef argument', + }, + + { + where => { -in => [ 'bob', 4, 2 ] }, + stmt => ' WHERE (bob IN (?, ?))', + bind => [ 4, 2 ], + test => 'Top level -in', + }, +# This works but then SQL::Abstract::Tree breaks - something for a later commit +# { +# where => { -in => [ { -list => [ qw(x y) ] }, { -list => [ 1, 3 ] }, { -list => [ 2, 4 ] } ] }, +# stmt => ' WHERE ((x, y) IN ((?, ?), (?, ?))', +# bind => [ 1, 3, 2, 4 ], +# test => 'Top level -in with list args', +# }, + { + where => { -between => [42, 69] }, + throws => qr/Fatal: Operator 'BETWEEN' requires/, + test => 'Top level -between with broken args', + }, + { + where => { + -between => [ + { -op => [ '+', { -ident => 'foo' }, 2 ] }, + 3, 4 + ], + }, + stmt => ' WHERE (foo + ? BETWEEN ? AND ?)', + bind => [ 2, 3, 4 ], + test => 'Top level -between with useful LHS', + }, + { + where => { + -in => [ + { -row => [ 'x', 'y' ] }, + { -row => [ 1, 2 ] }, + { -row => [ 3, 4 ] }, + ], + }, + stmt => ' WHERE (x, y) IN ((?, ?), (?, ?))', + bind => [ 1..4 ], + test => 'Complex top-level -in', + }, + { + where => { -is => [ 'bob', undef ] }, + stmt => ' WHERE bob IS NULL', + bind => [], + test => 'Top level -is ok', + }, + { + where => { -op => [ in => x => 1, 2, 3 ] }, + stmt => ' WHERE x IN (?, ?, ?)', + bind => [ 1, 2, 3 ], + test => 'Raw -op passes through correctly' + }, + ); for my $case (@in_between_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; local $SQL::Abstract::Test::parenthesis_significant = $case->{parenthesis_significant}; + my $label = $case->{test} || 'in-between test'; - local $Data::Dumper::Terse = 1; - - my @w; - local $SIG{__WARN__} = sub { push @w, @_ }; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); - if ($case->{exception}) { - throws_ok { $sql->where($case->{where}) } $case->{exception}; + if (my $e = $case->{throws}) { + my $stmt; + throws_ok { ($stmt) = $sql->where($case->{where}) } $e, "$label throws correctly" + or diag dumper ({ where => $case->{where}, result => $stmt }); } else { + my ($stmt, @bind); lives_ok { - my ($stmt, @bind) = $sql->where($case->{where}); + warnings_are { + ($stmt, @bind) = $sql->where($case->{where}); + } [], "$label gives no warnings"; + is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind}, - ) || diag "Search term:\n" . Dumper $case->{where}; - } "$case->{test} doesn't die"; + "$label generates correct SQL and bind", + ) || diag dumper ({ where => $case->{where}, exp => $sql->_expand_expr($case->{where}) }); + } || diag dumper ({ where => $case->{where}, exp => $sql->_expand_expr($case->{where}) }); } - - is (@w, 0, $case->{test} || 'No warnings within in-between tests') - || diag join "\n", 'Emitted warnings:', @w; } }