X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=027b5d9409ebb5c5906ca890b609434d8547276d;hb=HEAD;hp=1d73dff0f28337f67e7a1a442503438fabd4fc23;hpb=4f30591bc0678f8a5d657e79c6985606b064cd1d;p=scpubgit%2FQ-Branch.git diff --git a/t/04modifiers.t b/t/04modifiers.t index 1d73dff..027b5d9 100644 --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -1,23 +1,30 @@ -#!/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: * Modifiers are respected in both hashrefs and arrayrefs (with the obvious limitation of one modifier type per hahsref) - * When in condition context i.e. where => { -or { a = 1 } }, each modifier + * 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. - where => { x => { '!=', [-and, [qw/1 2 3/]] } }, a modifier affects the + * 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 =cut @@ -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 ], @@ -145,7 +152,6 @@ my @and_or_tests = ( }, # test column multi-cond in arrayref (even more useful) { -# todo => 'Clarify semantics in 1.52', where => { x => { '!=' => [ -and => (1 .. 3) ] } }, stmt => 'WHERE x != ? AND x != ? AND x != ?', bind => [1..3], @@ -153,18 +159,17 @@ my @and_or_tests = ( # the -or should affect only the inner hashref, as we are not in an outer arrayref { -# todo => 'Clarify semantics in 1.52', 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%/], @@ -178,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/], }, { @@ -198,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/], }, { @@ -210,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 => [ @@ -340,60 +345,109 @@ 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) { TODO: { local $TODO = $case->{todo} if $case->{todo}; - local $Data::Dumper::Terse = 1; + my $sql = SQL::Abstract->new($case->{args} || {}); - 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 { + lives_ok { + my ($stmt, @bind) = $sql->where($case->{where}); + is_same_sql_bind( + $stmt, + \@bind, + $case->{stmt}, + $case->{bind}, + ) || (diag_where ( $case->{where} ), diag dumper ([ EXP => $sql->_expand_expr($case->{where}) ])); + } || (diag_where ( $case->{where} ), diag dumper ([ EXP => $sql->_expand_expr($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 "Search term:\n" . Dumper $case->{where}; + ) || (diag_where ( $case->{where} ), diag dumper ([ EXP => $sql->_expand_expr($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 $sql = SQL::Abstract->new($case->{args} || {}); + lives_ok { 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;