X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=3504e6b98a02793058e68d01e712bed9476a8742;hb=970841131ca052eb8d4762dfd7a21205e24013aa;hp=c4960bac71fc5ca983edcdfa877cd9d3a3a07e16;hpb=9dda4913c78b4806af235f7faa3aae0db6ff75b7;p=dbsrgits%2FSQL-Abstract.git diff --git a/t/04modifiers.t b/t/04modifiers.t old mode 100755 new mode 100644 index c4960ba..3504e6b --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -1,13 +1,20 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; use Test::Exception; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use Test::Warn; +use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)]; -use Data::Dumper; use SQL::Abstract; +use Storable 'dclone'; + +#### WARNING #### +# +# -nest has been undocumented on purpose, but is still supported for the +# foreseable future. Do not rip out the -nest tests before speaking to +# someone on the DBIC mailing list or in irc.perl.org#dbix-class +# +################# =begin Test -and -or and -nest modifiers, assuming the following: @@ -16,7 +23,7 @@ Test -and -or and -nest modifiers, assuming the following: limitation of one modifier type per hahsref) * When in condition context i.e. where => { -or { a = 1 } }, each modifier affects only the immediate element following it. - * When in column multi-condition context i.e. + * When in column multi-condition context i.e. where => { x => { '!=', [-and, [qw/1 2 3/]] } }, a modifier affects the OUTER ARRAYREF if and only if it is the first element of said ARRAYREF @@ -67,7 +74,7 @@ my @and_or_tests = ( %{$and_or_args->{or}}, }, - # test modifiers within hashrefs + # test modifiers within hashrefs { where => { -or => [ [ foo => 1, bar => 2 ], @@ -83,7 +90,7 @@ my @and_or_tests = ( %{$and_or_args->{or_and}}, }, - # test modifiers within arrayrefs + # test modifiers within arrayrefs { where => [ -or => [ [ foo => 1, bar => 2 ], @@ -155,14 +162,14 @@ my @and_or_tests = ( where => { x => { -or => { '!=', 1, '>=', 2 }, -like => 'x%' }}, - stmt => 'WHERE (x != ? OR x >= ?) AND x LIKE ?', - bind => [qw/1 2 x%/], + stmt => 'WHERE x LIKE ? AND ( x != ? OR x >= ? )', + bind => [qw/x% 1 2/], }, # the -and should affect the OUTER arrayref, while the internal structures remain intact { - where => { x => [ - -and => [ 1, 2 ], { -like => 'x%' } + where => { x => [ + -and => [ 1, 2 ], { -like => 'x%' } ]}, stmt => 'WHERE (x = ? OR x = ?) AND x LIKE ?', bind => [qw/1 2 x%/], @@ -176,8 +183,8 @@ my @and_or_tests = ( { where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } }, - stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ((l = ? OR l = ?) OR c = ? OR d = ? ) AND x = ?', - bind => [qw/1 2 11 12 21 22 3 4 9/], + stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND (c = ? OR d = ? OR (l = ? OR l = ?) ) AND x = ?', + bind => [qw/1 2 11 12 3 4 21 22 9/], }, { @@ -196,8 +203,8 @@ my @and_or_tests = ( # explicit OR logic in arrays should leave everything intact args => { logic => 'or' }, where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } }, - stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ( l = ? OR l = ? OR c = ? OR d = ? ) AND x = ? ', - bind => [qw/1 2 11 12 21 22 3 4 9/], + stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ( c = ? OR d = ? OR l = ? OR l = ? ) AND x = ? ', + bind => [qw/1 2 11 12 3 4 21 22 9/], }, { @@ -208,7 +215,7 @@ my @and_or_tests = ( bind => [1 .. 13], }, - # 1st -and is in column mode, thus flips the entire array, whereas the + # 1st -and is in column mode, thus flips the entire array, whereas the # 2nd one is just a condition modifier { where => [ @@ -338,56 +345,107 @@ my @numbered_mods = ( }, ); -plan tests => @and_or_tests*3 + @numbered_mods*4; +my @nest_tests = ( + { + where => {a => 1, -nest => [b => 2, c => 3]}, + stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', + bind => [qw/2 3 1/], + }, + { + where => {a => 1, -nest => {b => 2, c => 3}}, + stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )', + bind => [qw/2 3 1/], + }, + { + where => {a => 1, -or => {-nest => {b => 2, c => 3}}}, + stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )', + bind => [qw/2 3 1/], + }, + { + where => {a => 1, -or => {-nest => [b => 2, c => 3]}}, + stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', + bind => [qw/2 3 1/], + }, + { + where => {a => 1, -nest => {-or => {b => 2, c => 3}}}, + stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', + bind => [qw/2 3 1/], + }, + { + where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]], + stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )', + bind => [qw/1 2 3 4 5/], + }, +); for my $case (@and_or_tests) { - local $Data::Dumper::Terse = 1; + TODO: { + local $TODO = $case->{todo} if $case->{todo}; - my @w; - local $SIG{__WARN__} = sub { push @w, @_ }; my $sql = SQL::Abstract->new ($case->{args} || {}); - lives_ok (sub { + + my $where_copy = dclone($case->{where}); + + warnings_are { my ($stmt, @bind) = $sql->where($case->{where}); is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind}, - ) - || diag "Search term:\n" . Dumper $case->{where}; + ) || diag_where( $case->{where} ); + } [], 'No warnings within and-or tests'; + + is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged'); + } +} + +for my $case (@nest_tests) { + TODO: { + local $TODO = $case->{todo} if $case->{todo}; + + local $SQL::Abstract::Test::parenthesis_significant = 1; + + my $sql = SQL::Abstract->new ($case->{args} || {}); + lives_ok (sub { + my ($stmt, @bind) = $sql->where($case->{where}); + is_same_sql_bind( + $stmt, + \@bind, + $case->{stmt}, + $case->{bind}, + ) || diag_where ( $case->{where} ); }); - is (@w, 0, 'No warnings within and-or tests') - || diag join "\n", 'Emitted warnings:', @w; + } } -my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E"; for my $case (@numbered_mods) { - local $Data::Dumper::Terse = 1; + TODO: { + local $TODO = $case->{todo} if $case->{todo}; + # not using Test::Warn here - variable amount of warnings my @w; local $SIG{__WARN__} = sub { push @w, @_ }; + my $sql = SQL::Abstract->new ($case->{args} || {}); - lives_ok (sub { + { my ($old_s, @old_b) = $sql->where($case->{backcompat}); my ($new_s, @new_b) = $sql->where($case->{correct}); is_same_sql_bind( $old_s, \@old_b, $new_s, \@new_b, 'Backcompat and the correct(tm) syntax result in identical statements', - ) || diag "Search terms:\n" . Dumper { - backcompat => $case->{backcompat}, - correct => $case->{correct}, - }; - }); - - ok (@w, 'Warnings were emitted about a mod_N construct'); - - my @non_match; - for (@w) { - push @non_match, $_ if ($_ !~ /$w_str/); - } - - is (@non_match, 0, 'All warnings match the deprecation message') - || diag join "\n", 'Rogue warnings:', @non_match; + ) || diag_where ( { + backcompat => $case->{backcompat}, + correct => $case->{correct}, + }); + }; + + ok ( (grep + { $_ =~ qr/\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0/ } + @w + ), 'Warnings were emitted about a mod_N construct'); + } } +done_testing;