1 package DBIC::SqlMakerTest;
6 use base qw/Test::Builder::Module Exporter/;
19 package DBIC::SqlMakerTest::SQLATest;
21 # replacement for SQL::Abstract::Test if not available
26 use base qw/Test::Builder::Module Exporter/;
28 use Scalar::Util qw(looks_like_number blessed reftype);
31 use Test::Deep qw(eq_deeply);
33 our $tb = __PACKAGE__->builder;
37 my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
39 my $same_sql = eq_sql($sql1, $sql2);
40 my $same_bind = eq_bind($bind_ref1, $bind_ref2);
42 $tb->ok($same_sql && $same_bind, $msg);
45 _sql_differ_diag($sql1, $sql2);
48 _bind_differ_diag($bind_ref1, $bind_ref2);
54 my ($sql1, $sql2, $msg) = @_;
56 my $same_sql = eq_sql($sql1, $sql2);
58 $tb->ok($same_sql, $msg);
61 _sql_differ_diag($sql1, $sql2);
67 my ($bind_ref1, $bind_ref2, $msg) = @_;
69 my $same_bind = eq_bind($bind_ref1, $bind_ref2);
71 $tb->ok($same_bind, $msg);
74 _bind_differ_diag($bind_ref1, $bind_ref2);
80 my ($sql1, $sql2) = @_;
82 $tb->diag("SQL expressions differ\n"
90 my ($bind_ref1, $bind_ref2) = @_;
92 $tb->diag("BIND values differ\n"
93 . " got: " . Dumper($bind_ref1)
94 . "expected: " . Dumper($bind_ref2)
100 my ($left, $right) = @_;
105 return $left eq $right;
110 my ($bind_ref1, $bind_ref2) = @_;
112 return eq_deeply($bind_ref1, $bind_ref2);
117 my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
119 return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
123 eval "use SQL::Abstract::Test;";
125 # SQL::Abstract::Test available
127 *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
128 *is_same_sql = \&SQL::Abstract::Test::is_same_sql;
129 *is_same_bind = \&SQL::Abstract::Test::is_same_bind;
130 *eq_sql = \&SQL::Abstract::Test::eq_sql;
131 *eq_bind = \&SQL::Abstract::Test::eq_bind;
132 *eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind;
136 *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
137 *is_same_sql = \&DBIC::SqlMakerTest::SQLATest::is_same_sql;
138 *is_same_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_bind;
139 *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
140 *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
141 *eq_sql_bind = \&DBIC::SqlMakerTest::SQLATest::eq_sql_bind;
152 DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC
157 use DBIC::SqlMakerTest;
159 my ($sql, @bind) = $schema->storage->sql_maker->select(%args);
162 $expected_sql, \@expected_bind,
168 Exports functions that can be used to compare generated SQL and bind values.
170 If L<SQL::Abstract::Test> (packaged in L<SQL::Abstract> versions 1.50 and
171 above) is available, then it is used to perform the comparisons (all functions
172 are delegated to id). Otherwise uses simple string comparison for the SQL
173 statements and simple L<Data::Dumper>-like recursive stringification for
174 comparison of bind values.
179 =head2 is_same_sql_bind
182 $given_sql, \@given_bind,
183 $expected_sql, \@expected_bind,
187 Compares given and expected pairs of C<($sql, \@bind)>, and calls
188 L<Test::Builder/ok> on the result, with C<$test_msg> as message.
198 Compares given and expected SQL statement, and calls L<Test::Builder/ok> on the
199 result, with C<$test_msg> as message.
209 Compares given and expected bind value lists, and calls L<Test::Builder/ok> on
210 the result, with C<$test_msg> as message.
214 my $is_same = eq_sql($given_sql, $expected_sql);
216 Compares the two SQL statements. Returns true IFF they are equivalent.
220 my $is_same = eq_sql(\@given_bind, \@expected_bind);
222 Compares two lists of bind values. Returns true IFF their values are the same.
226 my $is_same = eq_sql_bind(
227 $given_sql, \@given_bind,
228 $expected_sql, \@expected_bind
231 Compares the two SQL statements and the two lists of bind values. Returns true
232 IFF they are equivalent and the bind values are the same.
237 L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>.
241 Norbert Buchmuller, <norbi@nix.hu>
243 =head1 COPYRIGHT AND LICENSE
245 Copyright 2008 by Norbert Buchmuller.
247 This library is free software; you can redistribute it and/or modify
248 it under the same terms as Perl itself.