From: Norbert Buchmuller Date: Tue, 3 Feb 2009 14:57:02 +0000 (+0000) Subject: A new predicate sub: eq_sql_bind X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e7827ba2260e516f425de70d171dde5bac09f0a8;p=scpubgit%2FQ-Branch.git A new predicate sub: eq_sql_bind New test subs: is_same_sql, is_same_bind Documentation cleanup. --- diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm index 6da627c..1d18f2d 100644 --- a/lib/SQL/Abstract/Test.pm +++ b/lib/SQL/Abstract/Test.pm @@ -8,7 +8,8 @@ use Carp; use Test::Builder; use Test::Deep qw(eq_deeply); -our @EXPORT_OK = qw/&is_same_sql_bind &eq_sql &eq_bind +our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind + &eq_sql_bind &eq_sql &eq_bind $case_sensitive $sql_differ/; our $case_sensitive = 0; @@ -79,20 +80,69 @@ sub is_same_sql_bind { # add debugging info if (!$same_sql) { - $tb->diag("SQL expressions differ\n" - ." got: $sql1\n" - ."expected: $sql2\n" - ."differing in :\n$sql_differ\n" - ); + _sql_differ_diag($sql1, $sql2); } if (!$same_bind) { - $tb->diag("BIND values differ\n" - ." got: " . Dumper($bind_ref1) - ."expected: " . Dumper($bind_ref2) - ); + _bind_differ_diag($bind_ref1, $bind_ref2); } } +sub is_same_sql { + my ($sql1, $sql2, $msg) = @_; + + # compare + my $same_sql = eq_sql($sql1, $sql2); + + # call Test::Builder::ok + $tb->ok($same_sql, $msg); + + # add debugging info + if (!$same_sql) { + _sql_differ_diag($sql1, $sql2); + } +} + +sub is_same_bind { + my ($bind_ref1, $bind_ref2, $msg) = @_; + + # compare + my $same_bind = eq_bind($bind_ref1, $bind_ref2); + + # call Test::Builder::ok + $tb->ok($same_bind, $msg); + + # add debugging info + if (!$same_bind) { + _bind_differ_diag($bind_ref1, $bind_ref2); + } +} + +sub _sql_differ_diag { + my ($sql1, $sql2) = @_; + + $tb->diag("SQL expressions differ\n" + ." got: $sql1\n" + ."expected: $sql2\n" + ."differing in :\n$sql_differ\n" + ); +} + +sub _bind_differ_diag { + my ($bind_ref1, $bind_ref2) = @_; + + $tb->diag("BIND values differ\n" + ." got: " . Dumper($bind_ref1) + ."expected: " . Dumper($bind_ref2) + ); +} + +sub eq_sql_bind { + my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_; + + return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2); +} + + sub eq_bind { my ($bind_ref1, $bind_ref2) = @_; @@ -226,12 +276,25 @@ SQL::Abstract::Test - Helper function for testing SQL::Abstract use SQL::Abstract; use Test::More; - use SQL::Abstract::Test import => ['is_same_sql_bind']; + use SQL::Abstract::Test import => [qw/ + is_same_sql_bind is_same_sql is_same_bind + eq_sql_bind eq_sql eq_bind + /]; my ($sql, @bind) = SQL::Abstract->new->select(%args); + is_same_sql_bind($given_sql, \@given_bind, $expected_sql, \@expected_bind, $test_msg); + is_same_sql($given_sql, $expected_sql, $test_msg); + is_same_bind(\@given_bind, \@expected_bind, $test_msg); + + my $is_same = eq_sql_bind($given_sql, \@given_bind, + $expected_sql, \@expected_bind); + + my $sql_same = eq_sql($given_sql, $expected_sql); + my $bind_same = eq_bind(\@given_bind, \@expected_bind); + =head1 DESCRIPTION This module is only intended for authors of tests on @@ -257,34 +320,66 @@ laws, etc. $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 only function that needs to be -imported. +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. + +=head2 is_same_sql + + 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. + +=head2 is_same_bind + + 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. + +=head2 eq_sql_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. =head2 eq_sql my $is_same = eq_sql($given_sql, $expected_sql); -Compares the abstract syntax of two SQL statements. If the result is -false, global variable L will contain the SQL portion -where a difference was encountered; this is useful for printing diagnostics. +Compares the abstract syntax of two SQL statements. Similar to L, +but it just returns a boolean value and does not print diagnostics or talk to +L. If the result is false, the global variable L +will contain the SQL portion where a difference was encountered; this is useful +for printing diagnostics. =head2 eq_bind my $is_same = eq_sql(\@given_bind, \@expected_bind); -Compares two lists of bind values, taking into account -the fact that some of the values may be -arrayrefs (see L). +Compares two lists of bind values, taking into account the fact that some of +the values may be arrayrefs (see L). Similar to +L, but it just returns a boolean value and does not print +diagnostics or talk to L. =head1 GLOBAL VARIABLES -=head2 case_sensitive +=head2 $case_sensitive If true, SQL comparisons will be case-sensitive. Default is false; -=head2 sql_differ +=head2 $sql_differ When L returns false, the global variable C<$sql_differ> contains the SQL portion diff --git a/t/10test.t b/t/10test.t index f114d51..a776368 100644 --- a/t/10test.t +++ b/t/10test.t @@ -654,9 +654,12 @@ plan tests => 1 + map { $_ * ($_ - 1) / 2 } map { scalar @{$_->{bindvals}} } @bind_tests - ); + ) + + 3; -use_ok('SQL::Abstract::Test', import => [qw(eq_sql eq_bind is_same_sql_bind)]); +use_ok('SQL::Abstract::Test', import => [qw( + eq_sql_bind eq_sql eq_bind is_same_sql_bind +)]); for my $test (@sql_tests) { my $statements = $test->{statements}; @@ -697,3 +700,25 @@ for my $test (@bind_tests) { } } } + +ok(eq_sql_bind( + "SELECT * FROM foo WHERE id = ?", [42], + "SELECT * FROM foo WHERE (id = ?)", [42], + ), + "eq_sql_bind considers equal SQL expressions and bind values equal" +); + + +ok(!eq_sql_bind( + "SELECT * FROM foo WHERE id = ?", [42], + "SELECT * FROM foo WHERE (id = ?)", [0], + ), + "eq_sql_bind considers equal SQL expressions and different bind values different" +); + +ok(!eq_sql_bind( + "SELECT * FROM foo WHERE id = ?", [42], + "SELECT * FROM bar WHERE (id = ?)", [42], + ), + "eq_sql_bind considers different SQL expressions and equal bind values different" +);