From: Peter Rabbitson Date: Tue, 27 May 2014 18:06:03 +0000 (+0200) Subject: Port the \[] *_sql_bind unpacker from DBIC X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FQ-Branch.git;a=commitdiff_plain;h=70c6f0e91c090ef8fe0d2ceb1466bcf9e484cfb9 Port the \[] *_sql_bind unpacker from DBIC --- diff --git a/Changes b/Changes index 5d98116..e0bbbce 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ Revision history for SQL::Abstract - Fix parsing of binary ops to correctly take up only a single LHS element, instead of gobbling up the entire parse-to-date - Explicitly handle ROW_NUMBER() OVER as the snowflake-operator it is + - Improve signatures/documentation of is_same_sql_bind / eq_sql_bind revision 1.77 2014-01-17 ---------------------------- diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm index 419d516..5a82064 100644 --- a/lib/SQL/Abstract/Test.pm +++ b/lib/SQL/Abstract/Test.pm @@ -3,7 +3,6 @@ package SQL::Abstract::Test; # see doc at end of file use strict; use warnings; use base qw(Test::Builder::Module Exporter); -use Data::Dumper; use Test::Builder; use Test::Deep (); use SQL::Abstract::Tree; @@ -23,8 +22,30 @@ our $order_by_asc_significant = 0; our $sql_differ; # keeps track of differing portion between SQLs our $tb = __PACKAGE__->builder; +sub _unpack_arrayrefref { + + my @args; + for (1,2) { + my $chunk = shift @_; + + if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) { + my ($sql, @bind) = @$$chunk; + push @args, ($sql, \@bind); + } + else { + push @args, $chunk, shift @_; + } + + } + + # maybe $msg and ... stuff + push @args, @_; + + @args; +} + sub is_same_sql_bind { - my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; + my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = &_unpack_arrayrefref; # compare my $same_sql = eq_sql($sql1, $sql2); @@ -49,7 +70,7 @@ sub is_same_sql { my ($sql1, $sql2, $msg) = @_; # compare - my $same_sql = eq_sql($sql1, $sql2); + my $same_sql = eq_sql($sql1, $sql2); # call Test::Builder::ok my $ret = $tb->ok($same_sql, $msg); @@ -82,7 +103,12 @@ sub is_same_bind { } sub dumper { - Data::Dumper->new([])->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1)->Maxdepth(0)->Values([@_])->Dump; + # FIXME + # if we save the instance, we will end up with $VARx references + # no time to figure out how to avoid this (Deepcopy is *not* an option) + require Data::Dumper; + Data::Dumper->new([])->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1)->Maxdepth(0) + ->Values([@_])->Dump; } sub diag_where{ @@ -90,13 +116,14 @@ sub diag_where{ } sub _sql_differ_diag { - my ($sql1, $sql2) = @_; + my $sql1 = shift || ''; + my $sql2 = shift || ''; $tb->${\( $tb->in_todo ? 'note' : 'diag')} ( "SQL expressions differ\n" - ." got: $sql1\n" - ."expected: $sql2\n" - ."differing in :\n$sql_differ\n" + ." got: $sql1\n" + ."want: $sql2\n" + ."\nmismatch around\n$sql_differ\n" ); } @@ -104,14 +131,12 @@ sub _bind_differ_diag { my ($bind_ref1, $bind_ref2) = @_; $tb->${\( $tb->in_todo ? 'note' : 'diag')} ( - "BIND values differ\n" - ." got: " . dumper($bind_ref1) - ."expected: " . dumper($bind_ref2) - ); + "BIND values differ " . dumper({ got => $bind_ref1, want => $bind_ref2 }) + ); } sub eq_sql_bind { - my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_; + my ($sql1, $bind_ref1, $sql2, $bind_ref2) = &_unpack_arrayrefref; return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2); } @@ -267,52 +292,83 @@ B : the semantic equivalence handling is pretty limited. A lot of effort goes into distinguishing significant from non-significant parenthesis, including AND/OR operator associativity. Currently this module does not support commutativity and more -intelligent transformations like Morgan laws, etc. +intelligent transformations like L, etc. -For a good overview of what this test framework is capable of refer +For a good overview of what this test framework is currently capable of refer to C =head1 FUNCTIONS =head2 is_same_sql_bind - is_same_sql_bind($given_sql, \@given_bind, - $expected_sql, \@expected_bind, $test_msg); + is_same_sql_bind( + $given_sql, \@given_bind, + $expected_sql, \@expected_bind, + $test_msg + ); -Compares given and expected pairs of C<($sql, \@bind)>, and calls -L on the result, with C<$test_msg> as message. If the test -fails, a detailed diagnostic is printed. For clients which use L, -this is the one of the three functions (L, L, -L) that needs to be imported. + is_same_sql_bind( + \[$given_sql, @given_bind], + \[$expected_sql, @expected_bind], + $test_msg + ); + + is_same_sql_bind( + $dbic_rs->as_query + $expected_sql, \@expected_bind, + $test_msg + ); + +Compares given and expected pairs of C<($sql, \@bind)> by unpacking C<@_> +as shown in the examples above and passing the arguments to L and +L. Calls L with the combined result, with +C<$test_msg> as message. +If the test fails, a detailed diagnostic is printed. =head2 is_same_sql - is_same_sql($given_sql, $expected_sql, $test_msg); + is_same_sql( + $given_sql, + $expected_sql, + $test_msg + ); -Compares given and expected SQL statements, and calls L on -the result, with C<$test_msg> as message. If the test fails, a detailed -diagnostic is printed. For clients which use L, this is the one of -the three functions (L, L, L) -that needs to be imported. +Compares given and expected SQL statements via L, and calls +L on the result, with C<$test_msg> as message. +If the test fails, a detailed diagnostic is printed. =head2 is_same_bind - is_same_bind(\@given_bind, \@expected_bind, $test_msg); + is_same_bind( + \@given_bind, + \@expected_bind, + $test_msg + ); -Compares given and expected bind values, and calls L on the -result, with C<$test_msg> as message. If the test fails, a detailed diagnostic -is printed. For clients which use L, this is the one of the three -functions (L, L, L) that needs -to be imported. +Compares given and expected bind values via L, and calls +L on the result, with C<$test_msg> as message. +If the test fails, a detailed diagnostic is printed. =head2 eq_sql_bind - my $is_same = eq_sql_bind($given_sql, \@given_bind, - $expected_sql, \@expected_bind); + my $is_same = eq_sql_bind( + $given_sql, \@given_bind, + $expected_sql, \@expected_bind, + ); -Compares given and expected pairs of C<($sql, \@bind)>. Similar to -L, but it just returns a boolean value and does not print -diagnostics or talk to L. + my $is_same = eq_sql_bind( + \[$given_sql, @given_bind], + \[$expected_sql, @expected_bind], + ); + + my $is_same = eq_sql_bind( + $dbic_rs->as_query + $expected_sql, \@expected_bind, + ); + +Unpacks C<@_> depending on the given arguments and calls L and +L, returning their combined result. =head2 eq_sql @@ -356,14 +412,13 @@ When L returns false, the global variable C<$sql_differ> contains the SQL portion where a difference was encountered. - =head1 SEE ALSO L, L, L. =head1 AUTHORS -Laurent Dami, Elaurent.dami AT etat geneve chE +Laurent Dami Norbert Buchmuller diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm index 9edc1d7..decc5ed 100644 --- a/lib/SQL/Abstract/Tree.pm +++ b/lib/SQL/Abstract/Tree.pm @@ -325,6 +325,8 @@ sub new { sub parse { my ($self, $s) = @_; + return [] unless defined $s; + # tokenize string, and remove all optional whitespace my $tokens = []; foreach my $token (split $tokenizer_re, $s) { diff --git a/t/10test.t b/t/10test.t index 60d10d7..dc56f23 100644 --- a/t/10test.t +++ b/t/10test.t @@ -1093,4 +1093,17 @@ like( 'expected debug of missing branch', ); + +ok (eq_sql_bind ( + \[ 'SELECT foo FROM bar WHERE baz = ? or buzz = ?', [ {} => 1 ], 2 ], + 'SELECT foo FROM bar WHERE (baz = ?) OR buzz = ?', + [ [ {} => 1 ], 2 ], +), 'arrayrefref unpacks correctly' ); + +is_same_sql_bind( + \[ 'SELECT foo FROM bar WHERE baz = ? or buzz = ?', [ {} => 1 ], 2 ], + \[ 'SELECT foo FROM bar WHERE (( baz = ? OR (buzz = ?) ))', [ {} => 1 ], 2 ], + 'double arrayrefref unpacks correctly' +); + done_testing;