X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=702c2992c209180eb859aee02a24d2236042c0d0;hb=ca4f826a37ccb5194b0b5b9b4190b4007d647d9c;hp=b0735324cda58dfac5a4f7f552644aea2e7062fd;hpb=3a8b7db02691ad2fdce34b5acae819390b15b240;p=dbsrgits%2FSQL-Abstract.git diff --git a/t/04modifiers.t b/t/04modifiers.t index b073532..702c299 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 ], @@ -161,8 +168,8 @@ my @and_or_tests = ( # 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 => [ @@ -361,39 +368,35 @@ my @nest_tests = ( }, { where => {a => 1, -nest => {-or => {b => 2, c => 3}}}, - stmt => 'WHERE ( ( (c = ? OR b = ?) AND a = ? ) )', - bind => [qw/3 2 1/], + 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 = ? ) )', + stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )', bind => [qw/1 2 3 4 5/], }, ); -plan tests => @and_or_tests*3 + @numbered_mods*4 + @nest_tests*2; - 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 { my ($stmt, @bind) = $sql->where($case->{where}); is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind}, - ) - || diag "Search term:\n" . Dumper $case->{where}; - }); - is (@w, 0, 'No warnings within and-or tests') - || diag join "\n", 'Emitted warnings:', @w; + ) || diag_where( $case->{where} ); + } [], 'No warnings within and-or tests'; + + is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged'); } } @@ -402,9 +405,8 @@ for my $case (@nest_tests) { local $TODO = $case->{todo} if $case->{todo}; local $SQL::Abstract::Test::parenthesis_significant = 1; - local $Data::Dumper::Terse = 1; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); lives_ok (sub { my ($stmt, @bind) = $sql->where($case->{where}); is_same_sql_bind( @@ -412,46 +414,38 @@ for my $case (@nest_tests) { \@bind, $case->{stmt}, $case->{bind}, - ) - || diag "Search term:\n" . Dumper $case->{where}; + ) || diag_where ( $case->{where} ); }); } } - - -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) { TODO: { local $TODO = $case->{todo} if $case->{todo}; - local $Data::Dumper::Terse = 1; - + # 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} || {}); + { 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;