X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=027b5d9409ebb5c5906ca890b609434d8547276d;hb=cf5b7ab163f8ac123ebc9bb1156e79646cd5bd2f;hp=c8d3ce19b4c97c91dc7a9f1631a7aff1dd10a6fc;hpb=771ea2ecd7b6b670b4e04d81336abaf0b71186c5;p=scpubgit%2FQ-Branch.git diff --git a/t/04modifiers.t b/t/04modifiers.t index c8d3ce1..027b5d9 100644 --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -1,12 +1,10 @@ -#!/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'; @@ -23,10 +21,10 @@ 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 @@ -76,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 ], @@ -92,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 ], @@ -170,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%/], @@ -217,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 => [ @@ -384,27 +382,21 @@ for my $case (@and_or_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; - 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} || {}); my $where_copy = dclone($case->{where}); - 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}; - }); - is (@w, 0, 'No warnings within and-or tests') - || diag join "\n", 'Emitted warnings:', @w; + 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'); } @@ -415,9 +407,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( @@ -425,46 +416,37 @@ for my $case (@nest_tests) { \@bind, $case->{stmt}, $case->{bind}, - ) - || diag "Search term:\n" . Dumper $case->{where}; + ) || (diag_where ( $case->{where} ), diag dumper ([ EXP => $sql->_expand_expr($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} || {}); + 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'); } }