X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBIC%2FSqlMakerTest.pm;h=8fd047c3678dab9ba3cd19bd52e71aa5e929f3fe;hb=8273e845426f0187b4ad6c4a1b42286fa09a648f;hp=95ff407aa7cd82d683025eb30feeaac16d4c7f75;hpb=2564f119a0425302637f849270433cdf2e16a610;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBIC/SqlMakerTest.pm b/t/lib/DBIC/SqlMakerTest.pm index 95ff407..8fd047c 100644 --- a/t/lib/DBIC/SqlMakerTest.pm +++ b/t/lib/DBIC/SqlMakerTest.pm @@ -1,144 +1,55 @@ -package # hide from PAUSE - DBIC::SqlMakerTest; +package DBIC::SqlMakerTest; use strict; use warnings; -use base qw/Test::Builder::Module Exporter/; +use base qw/Exporter/; -use Exporter; +use Carp; +use SQL::Abstract::Test; our @EXPORT = qw/ - &is_same_sql_bind - &eq_sql - &eq_bind + is_same_sql_bind + is_same_sql + is_same_bind +/; +our @EXPORT_OK = qw/ + eq_sql + eq_bind + eq_sql_bind /; +sub is_same_sql_bind { + # unroll possible as_query arrayrefrefs + my @args; -{ - 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 Scalar::Util qw(looks_like_number blessed reftype); - 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); + for (1,2) { + my $chunk = shift @_; - if (!$same_sql) { - $tb->diag("SQL expressions differ\n" - . " got: $sql1\n" - . "expected: $sql2\n" - ); + if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) { + my ($sql, @bind) = @$$chunk; + push @args, ($sql, \@bind); } - if (!$same_bind) { - $tb->diag("BIND values differ\n" - . " got: " . Dumper($bind_ref1) - . "expected: " . Dumper($bind_ref2) - ); + else { + push @args, $chunk, shift @_; } - } - - sub eq_sql - { - my ($left, $right) = @_; - $left =~ s/\s+//g; - $right =~ s/\s+//g; - - 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; - } - } - } -} - -eval "use SQL::Abstract::Test;"; -if ($@ eq '') { - # SQL::Abstract::Test available + push @args, shift @_; - *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 + croak "Unexpected argument(s) supplied to is_same_sql_bind: " . join ('; ', @_) + if @_; - *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; + @_ = @args; + goto &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; 1; @@ -153,10 +64,10 @@ DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC use Test::More; use DBIC::SqlMakerTest; - + my ($sql, @bind) = $schema->storage->sql_maker->select(%args); is_same_sql_bind( - $sql, \@bind, + $sql, \@bind, $expected_sql, \@expected_bind, 'foo bar works' ); @@ -165,19 +76,27 @@ DBIC::SqlMakerTest - Helper package for testing sql_maker component of DBIC 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. - +This is a thin wrapper around L, which makes it easier +to compare as_query sql/bind arrayrefrefs directly. =head1 FUNCTIONS =head2 is_same_sql_bind is_same_sql_bind( - $given_sql, \@given_bind, + $given_sql, \@given_bind, + $expected_sql, \@expected_bind, + $test_msg + ); + + is_same_sql_bind( + $rs->as_query + $expected_sql, \@expected_bind, + $test_msg + ); + + is_same_sql_bind( + \[$given_sql, @given_bind], $expected_sql, \@expected_bind, $test_msg ); @@ -185,6 +104,28 @@ comparison of bind values. Compares given and expected pairs of C<($sql, \@bind)>, and calls L 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 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 on +the result, with C<$test_msg> as message. + =head2 eq_sql my $is_same = eq_sql($given_sql, $expected_sql); @@ -197,6 +138,16 @@ Compares the two SQL statements. Returns true IFF they are equivalent. 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 @@ -211,4 +162,4 @@ Norbert Buchmuller, 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. +it under the same terms as Perl itself.