From: Norbert Buchmuller Date: Tue, 25 Nov 2008 06:32:57 +0000 (+0100) Subject: * Wrapped SQL::Abstract::Test functionality in a new module (DBIC::SqlMakerTest). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=949172b0fa30a832d268c3f55f97247a10742314;p=dbsrgits%2FDBIx-Class-Historic.git * Wrapped SQL::Abstract::Test functionality in a new module (DBIC::SqlMakerTest). * Made a test SKIP that does not work with SQL::Abstract < 1.49 (used to be a TODO test). --- diff --git a/t/19quotes.t b/t/19quotes.t index 2412e1d..19d4031 100644 --- a/t/19quotes.t +++ b/t/19quotes.t @@ -3,7 +3,7 @@ use warnings; use Test::More; use IO::File; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; BEGIN { eval "use DBD::SQLite"; diff --git a/t/19quotes_newstyle.t b/t/19quotes_newstyle.t index 124bd65..5b8fcc7 100644 --- a/t/19quotes_newstyle.t +++ b/t/19quotes_newstyle.t @@ -3,7 +3,7 @@ use warnings; use Test::More; use IO::File; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; BEGIN { eval "use DBD::SQLite"; diff --git a/t/41orrible.t b/t/41orrible.t index 54633ce..030dabc 100644 --- a/t/41orrible.t +++ b/t/41orrible.t @@ -3,7 +3,7 @@ use warnings; use Test::More; #use DBIx::Class::Storage::DBI; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; use DBIx::Class::Storage::DBI::Oracle::WhereJoins; plan tests => 4; diff --git a/t/76joins.t b/t/76joins.t index 744bfd7..5d90d21 100644 --- a/t/76joins.t +++ b/t/76joins.t @@ -5,7 +5,7 @@ use Test::More; use lib qw(t/lib); use DBICTest; use Data::Dumper; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; my $schema = DBICTest->init_schema(); diff --git a/t/91debug.t b/t/91debug.t index 5314ce4..ef9dfd4 100644 --- a/t/91debug.t +++ b/t/91debug.t @@ -5,7 +5,7 @@ use Test::More; use lib qw(t/lib); use DBICTest; use DBICTest::DBICDebugObj; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; my $schema = DBICTest->init_schema(); diff --git a/t/95sql_maker.t b/t/95sql_maker.t index ee6ccdd..574e953 100644 --- a/t/95sql_maker.t +++ b/t/95sql_maker.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; BEGIN { diff --git a/t/95sql_maker_quote.t b/t/95sql_maker_quote.t index 162c59f..0a385dc 100644 --- a/t/95sql_maker_quote.t +++ b/t/95sql_maker_quote.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More; -use SQL::Abstract::Test import => ['is_same_sql_bind']; +use DBIC::SqlMakerTest; BEGIN { @@ -237,27 +237,31 @@ is_same_sql_bind( 'quoted table names for UPDATE' ); +SKIP: { + skip 1, "select attr with star does not work in SQL::Abstract < 1.49" + if $SQL::Abstract::VERSION < 1.49; -($sql, @bind) = $sql_maker->select( - [ - { - 'me' => 'cd' - } - ], - [ - 'me.*' - ], - undef, - [], - undef, - undef -); + ($sql, @bind) = $sql_maker->select( + [ + { + 'me' => 'cd' + } + ], + [ + 'me.*' + ], + undef, + [], + undef, + undef + ); -is_same_sql_bind( - $sql, \@bind, - q/SELECT `me`.* FROM `cd` `me`/, [], - 'select attr with me.* is right' -); + is_same_sql_bind( + $sql, \@bind, + q/SELECT `me`.* FROM `cd` `me`/, [], + 'select attr with me.* is right' + ); +} $sql_maker->quote_char([qw/[ ]/]); diff --git a/t/lib/DBIC/SqlMakerTest.pm b/t/lib/DBIC/SqlMakerTest.pm new file mode 100644 index 0000000..0dce0d1 --- /dev/null +++ b/t/lib/DBIC/SqlMakerTest.pm @@ -0,0 +1,177 @@ +package # hide from PAUSE + DBIC::SqlMakerTest; + +use strict; +use warnings; + +use base qw/Test::Builder::Module Exporter/; + +use Exporter; +use Data::Dumper; + +our @EXPORT = qw/ + &is_same_sql_bind + &eq_sql + &eq_bind +/; + + +{ + package # hide from PAUSE + DBIC::SqlMakerTest::SQLATest; + + # replacement for SQL::Abstract::Test if not available + + use strict; + use warnings; + + use base qw/Test::Builder::Module Exporter/; + + use Data::Dumper; + + our $tb = __PACKAGE__->builder; + + sub is_same_sql_bind + { + my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; + + my $same_sql = eq_sql($sql1, $sql2); + my $same_bind = eq_bind($bind_ref1, $bind_ref2); + + $tb->ok($same_sql && $same_bind, $msg); + + if (!$same_sql) { + $tb->diag("SQL expressions differ\n" + . " got: $sql1\n" + . "expected: $sql2\n" + ); + } + if (!$same_bind) { + $tb->diag("BIND values differ\n" + . " got: " . Dumper($bind_ref1) + . "expected: " . Dumper($bind_ref2) + ); + } + } + + sub eq_sql + { + my ($left, $right) = @_; + + $left =~ s/\s+//g; + $right =~ s/\s+//g; + + return $left eq $right; + } + + sub eq_bind + { + my ($bind_ref1, $bind_ref2) = @_; + + return stringify_bind($bind_ref1) eq stringify_bind($bind_ref2); + } + + sub stringify_bind + { + my ($bind) = @_; + + foreach (ref $bind) { + /^$/ and return $bind; + /^ARRAY$/ and return join("\n", map { stringify_bind($_) } @$bind); + /^HASH$/ and return join( + "\n", map { $_ . " => " . stringify_bind($bind->{$_}) } keys %$bind + ); + /^SCALAR$/ and return "\\" . stringify_bind($$bind); + return '' . $bind; + } + } +} + +eval "use SQL::Abstract::Test;"; +if ($@ eq '') { + # SQL::Abstract::Test available + + *is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind; + *eq_sql = \&SQL::Abstract::Test::eq_sql; + *eq_bind = \&SQL::Abstract::Test::eq_bind; +} else { + # old SQL::Abstract + + *is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind; + *eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql; + *eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind; +} + + +1; + +__END__ + + +=head1 NAME + +DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC + +=head1 SYNOPSIS + + use Test::More; + use DBIC::SqlMakerTest; + + my ($sql, @bind) = $schema->storage->sql_maker->select(%args); + is_same_sql_bind( + $sql, \@bind, + $expected_sql, \@expected_bind, + 'foo bar works' + ); + +=head1 DESCRIPTION + +Exports functions that can be used to compare generated SQL and bind values. + +If L (packaged in L versions 1.50 and +above) is available, then it is used to perform the comparisons (all functions +are delegated to id). Otherwise uses simple string comparison for the SQL +statements and simple L-like recursive stringification for +comparison of bind values. + + +=head1 FUNCTIONS + +=head2 is_same_sql_bind + + 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. + +=head2 eq_sql + + my $is_same = eq_sql($given_sql, $expected_sql); + +Compares the two SQL statements. Returns true IFF they are equivalent. + +=head2 eq_bind + + my $is_same = eq_sql(\@given_bind, \@expected_bind); + +Compares two lists of bind values. Returns true IFF their values are the same. + + +=head1 SEE ALSO + +L, L, L. + +=head1 AUTHOR + +Norbert Buchmuller, + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 by Norbert Buchmuller. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself.