X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=a271b3252efe546fc4771bcc84f5319bf7726d7e;hb=21acf7723e77f244cfac020898e411dc0ab37a52;hp=27db12cd09b9240f66c11626eea529b0bbc6e2c7;hpb=46dc2f3e47d514cd376003cea2df63222c492b0b;p=dbsrgits%2FSQL-Abstract.git diff --git a/t/04modifiers.t b/t/04modifiers.t index 27db12c..a271b32 100644 --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -2,6 +2,7 @@ use strict; use warnings; use Test::More; use Test::Exception; +use Test::Warn; use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)]; use SQL::Abstract; @@ -20,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 + 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 @@ -381,24 +382,19 @@ for my $case (@and_or_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; - 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 { + warnings_are { 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; + ) || (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'); } @@ -410,7 +406,7 @@ for my $case (@nest_tests) { local $SQL::Abstract::Test::parenthesis_significant = 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( @@ -418,22 +414,21 @@ for my $case (@nest_tests) { \@bind, $case->{stmt}, $case->{bind}, - ) || diag_where ( $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}; + # 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( @@ -444,17 +439,12 @@ for my $case (@numbered_mods) { 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; + 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'); } }