-package # hide from PAUSE
- DBIC::SqlMakerTest;
+package DBIC::SqlMakerTest;
use strict;
use warnings;
use base qw/Test::Builder::Module Exporter/;
-use Exporter;
-
our @EXPORT = qw/
&is_same_sql_bind
+ &is_same_sql
+ &is_same_bind
&eq_sql
&eq_bind
+ &eq_sql_bind
/;
{
- package # hide from PAUSE
- DBIC::SqlMakerTest::SQLATest;
+ package DBIC::SqlMakerTest::SQLATest;
# replacement for SQL::Abstract::Test if not available
use Scalar::Util qw(looks_like_number blessed reftype);
use Data::Dumper;
+ use Test::Builder;
+ use Test::Deep qw(eq_deeply);
our $tb = __PACKAGE__->builder;
$tb->ok($same_sql && $same_bind, $msg);
if (!$same_sql) {
- $tb->diag("SQL expressions differ\n"
- . " got: $sql1\n"
- . "expected: $sql2\n"
- );
+ _sql_differ_diag($sql1, $sql2);
+ }
+ if (!$same_bind) {
+ _bind_differ_diag($bind_ref1, $bind_ref2);
+ }
+ }
+
+ sub is_same_sql
+ {
+ my ($sql1, $sql2, $msg) = @_;
+
+ my $same_sql = eq_sql($sql1, $sql2);
+
+ $tb->ok($same_sql, $msg);
+
+ if (!$same_sql) {
+ _sql_differ_diag($sql1, $sql2);
}
+ }
+
+ sub is_same_bind
+ {
+ my ($bind_ref1, $bind_ref2, $msg) = @_;
+
+ my $same_bind = eq_bind($bind_ref1, $bind_ref2);
+
+ $tb->ok($same_bind, $msg);
+
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 _sql_differ_diag
+ {
+ my ($sql1, $sql2) = @_;
+
+ $tb->diag("SQL expressions differ\n"
+ . " got: $sql1\n"
+ . "expected: $sql2\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
{
my ($left, $right) = @_;
return $left eq $right;
}
- # lifted from SQL::Abstract::Test
sub eq_bind
{
my ($bind_ref1, $bind_ref2) = @_;
- my $ref1 = ref $bind_ref1;
- my $ref2 = ref $bind_ref2;
-
- return 0 if $ref1 ne $ref2;
-
- if ($ref1 eq 'SCALAR' || $ref1 eq 'REF') {
- return eq_bind($$bind_ref1, $$bind_ref2);
- } elsif ($ref1 eq 'ARRAY') {
- return 0 if scalar @$bind_ref1 != scalar @$bind_ref2;
- for (my $i = 0; $i < @$bind_ref1; $i++) {
- return 0 if !eq_bind($bind_ref1->[$i], $bind_ref2->[$i]);
- }
- return 1;
- } elsif ($ref1 eq 'HASH') {
- return
- eq_bind(
- [sort keys %$bind_ref1],
- [sort keys %$bind_ref2]
- )
- && eq_bind(
- [map { $bind_ref1->{$_} } sort keys %$bind_ref1],
- [map { $bind_ref2->{$_} } sort keys %$bind_ref2]
- );
- } else {
- if (!defined $bind_ref1 || !defined $bind_ref2) {
- return !(defined $bind_ref1 ^ defined $bind_ref2);
- } elsif (blessed($bind_ref1) || blessed($bind_ref2)) {
- return 0 if (blessed($bind_ref1) || "") ne (blessed($bind_ref2) || "");
- return 1 if $bind_ref1 == $bind_ref2; # uses overloaded '=='
- # fallback: compare the guts of the object
- my $reftype1 = reftype $bind_ref1;
- my $reftype2 = reftype $bind_ref2;
- return 0 if $reftype1 ne $reftype2;
- if ($reftype1 eq 'SCALAR' || $reftype1 eq 'REF') {
- $bind_ref1 = $$bind_ref1;
- $bind_ref2 = $$bind_ref2;
- } elsif ($reftype1 eq 'ARRAY') {
- $bind_ref1 = [@$bind_ref1];
- $bind_ref2 = [@$bind_ref2];
- } elsif ($reftype1 eq 'HASH') {
- $bind_ref1 = {%$bind_ref1};
- $bind_ref2 = {%$bind_ref2};
- } else {
- return 0;
- }
- return eq_bind($bind_ref1, $bind_ref2);
- } elsif (looks_like_number($bind_ref1) && looks_like_number($bind_ref2)) {
- return $bind_ref1 == $bind_ref2;
- } else {
- return $bind_ref1 eq $bind_ref2;
- }
- }
+ return eq_deeply($bind_ref1, $bind_ref2);
+ }
+
+ sub eq_sql_bind
+ {
+ my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
+
+ return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
}
}
# SQL::Abstract::Test available
*is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
+ *is_same_sql = \&SQL::Abstract::Test::is_same_sql;
+ *is_same_bind = \&SQL::Abstract::Test::is_same_bind;
*eq_sql = \&SQL::Abstract::Test::eq_sql;
*eq_bind = \&SQL::Abstract::Test::eq_bind;
+ *eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind;
} else {
# old SQL::Abstract
*is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
+ *is_same_sql = \&DBIC::SqlMakerTest::SQLATest::is_same_sql;
+ *is_same_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_bind;
*eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
*eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
+ *eq_sql_bind = \&DBIC::SqlMakerTest::SQLATest::eq_sql_bind;
}
Compares given and expected pairs of C<($sql, \@bind)>, and calls
L<Test::Builder/ok> on the result, with C<$test_msg> as message.
+=head2 is_same_sql
+
+ is_same_sql(
+ $given_sql,
+ $expected_sql,
+ $test_msg
+ );
+
+Compares given and expected SQL statement, and calls L<Test::Builder/ok> on the
+result, with C<$test_msg> as message.
+
+=head2 is_same_bind
+
+ is_same_bind(
+ \@given_bind,
+ \@expected_bind,
+ $test_msg
+ );
+
+Compares given and expected bind value lists, and calls L<Test::Builder/ok> on
+the result, with C<$test_msg> as message.
+
=head2 eq_sql
my $is_same = eq_sql($given_sql, $expected_sql);
Compares two lists of bind values. Returns true IFF their values are the same.
+=head2 eq_sql_bind
+
+ my $is_same = eq_sql_bind(
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind
+ );
+
+Compares the two SQL statements and the two lists of bind values. Returns true
+IFF they are equivalent and the bind values are the same.
+
=head1 SEE ALSO
projects / dbsrgits/DBIx-Class.git / blobdiff