X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F04modifiers.t;h=c8d3ce19b4c97c91dc7a9f1631a7aff1dd10a6fc;hb=771ea2ecd7b6b670b4e04d81336abaf0b71186c5;hp=5815af3b802d6b7a2e98c51096af7013526990e9;hpb=d92d804b3d06c8110b12512b62333c6aec506993;p=dbsrgits%2FSQL-Abstract.git diff --git a/t/04modifiers.t b/t/04modifiers.t index 5815af3..c8d3ce1 100644 --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -8,9 +8,18 @@ use SQL::Abstract::Test import => ['is_same_sql_bind']; 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 modifiers, assuming the following: +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) @@ -299,30 +308,29 @@ my @and_or_tests = ( ); # modN and mod_N were a bad design decision - they go away in SQLA2, warn now -# -nest is renamed to -paren -my @backcompat_mods = ( +my @numbered_mods = ( { backcompat => { - -and5 => [a => 10, b => 11], - -and_2 => [ c => 20, d => 21 ], + -and => [a => 10, b => 11], + -and2 => [ c => 20, d => 21 ], -nest => [ x => 1 ], -nest2 => [ y => 2 ], - -or7 => { m => 7, n => 8 }, - -or_2 => { m => 17, n => 18 }, + -or => { m => 7, n => 8 }, + -or2 => { m => 17, n => 18 }, }, correct => { -and => [ -and => [a => 10, b => 11], -and => [ c => 20, d => 21 ], - -paren => [ x => 1 ], - -paren => [ y => 2 ], + -nest => [ x => 1 ], + -nest => [ y => 2 ], -or => { m => 7, n => 8 }, -or => { m => 17, n => 18 }, ] }, }, { backcompat => { - -and => [a => 10, b => 11], - -and2 => [ c => 20, d => 21 ], + -and2 => [a => 10, b => 11], + -and_3 => [ c => 20, d => 21 ], -nest2 => [ x => 1 ], -nest_3 => [ y => 2 ], -or2 => { m => 7, n => 8 }, @@ -331,49 +339,47 @@ my @backcompat_mods = ( correct => [ -and => [ -and => [a => 10, b => 11], -and => [ c => 20, d => 21 ], - -paren => [ x => 1 ], - -paren => [ y => 2 ], + -nest => [ x => 1 ], + -nest => [ y => 2 ], -or => { m => 7, n => 8 }, -or => { m => 17, n => 18 }, ] ], }, ); -my @paren_tests = ( +my @nest_tests = ( { - where => {a => 1, -paren => [b => 2, c => 3]}, + where => {a => 1, -nest => [b => 2, c => 3]}, stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', bind => [qw/2 3 1/], }, { - where => {a => 1, -paren => {b => 2, c => 3}}, + where => {a => 1, -nest => {b => 2, c => 3}}, stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )', bind => [qw/2 3 1/], }, { - where => {a => 1, -or => {-paren => {b => 2, c => 3}}}, + 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 => {-paren => [b => 2, c => 3]}}, + where => {a => 1, -or => {-nest => [b => 2, c => 3]}}, stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', bind => [qw/2 3 1/], }, { - where => {a => 1, -paren => {-or => {b => 2, c => 3}}}, + where => {a => 1, -nest => {-or => {b => 2, c => 3}}}, stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', bind => [qw/2 3 1/], }, { - where => [a => 1, -paren => {b => 2, c => 3}, -paren => [d => 4, e => 5]], + 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/], }, ); -plan tests => @and_or_tests*3 + @backcompat_mods*4 + @paren_tests*2; - for my $case (@and_or_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; @@ -382,7 +388,11 @@ for my $case (@and_or_tests) { my @w; local $SIG{__WARN__} = sub { push @w, @_ }; + 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( @@ -395,10 +405,12 @@ for my $case (@and_or_tests) { }); is (@w, 0, 'No warnings within and-or tests') || diag join "\n", 'Emitted warnings:', @w; + + is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged'); } } -for my $case (@paren_tests) { +for my $case (@nest_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; @@ -419,26 +431,17 @@ for my $case (@paren_tests) { } } -my $numw_str = "\QUse of op_N modifiers is deprecated and will be removed in SQLA v2.0\E"; -my $nestw_str = "\QThe -nest modifier is deprecated in favor of -paren and will be removed in SQLA v2.0\E"; -for my $case (@backcompat_mods) { + + +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; - my $w; - local $SIG{__WARN__} = sub { - if ($_[0] =~ /$numw_str/) { - push @{$w->{num}}, $_[0]; - } - elsif ($_[0] =~ /$nestw_str/) { - push @{$w->{nest}}, $_[0]; - } - else { - warn $_[0]; - } - }; + 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}); @@ -453,8 +456,16 @@ for my $case (@backcompat_mods) { }; }); - is (@{$w->{num} || []}, 5, 'Correct number of warnings were emitted about a mod_N operator'); - is (@{$w->{nest} || []}, 2, 'Correct number of warnings were emitted about a -nest operator'); + 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; } } +done_testing;