From: Norbert Buchmuller Date: Wed, 26 Nov 2008 22:35:33 +0000 (+0000) Subject: Reimplemented SQL::Abstract::Test::eq_bind to compare the data structures instead... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=32c343797dddfe975ee1e7b97793c7496e765139;p=scpubgit%2FQ-Branch.git Reimplemented SQL::Abstract::Test::eq_bind to compare the data structures instead of stringifying them. Added tests for eq_bind. --- diff --git a/MANIFEST b/MANIFEST index 039267f..9503a39 100644 --- a/MANIFEST +++ b/MANIFEST @@ -12,5 +12,4 @@ t/06order_by.t t/07subqueries.t t/08special_ops.t t/09refkind.t - - +t/10test.t diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm index 55c2e99..49f7800 100644 --- a/lib/SQL/Abstract/Test.pm +++ b/lib/SQL/Abstract/Test.pm @@ -3,6 +3,7 @@ package SQL::Abstract::Test; # see doc at end of file use strict; use warnings; use base qw/Test::Builder::Module Exporter/; +use Scalar::Util qw(looks_like_number blessed reftype); use Data::Dumper; use Carp; @@ -41,31 +42,61 @@ sub is_same_sql_bind { } } - sub eq_bind { my ($bind_ref1, $bind_ref2) = @_; - return stringify_bind($bind_ref1) eq stringify_bind($bind_ref2); -} -sub stringify_bind { - my $bind_ref = shift || []; - - # some bind values can be arrayrefs (see L), - # so stringify them. - # furthermore, if L is set to true, elements - # of those arrayrefs can be arrayrefs, too. - my @strings = map { - ref $_ eq 'ARRAY' - ? join('=>', map { - ref $_ eq 'ARRAY' - ? ('[' . join('=>', @$_) . ']') - : (defined $_ ? $_ : '') - } @$_) - : (defined $_ ? $_ : '') - } @$bind_ref; - - # join all values into a single string - return join "///", @strings; + 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; + } + } } sub eq_sql { diff --git a/t/10test.t b/t/10test.t new file mode 100644 index 0000000..af6404d --- /dev/null +++ b/t/10test.t @@ -0,0 +1,229 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use List::Util qw(sum); +use Data::Dumper; + +use Test::More; + + +my @bind_tests = ( + # scalar - equal + { + equal => 1, + bindvals => [ + undef, + undef, + ] + }, + { + equal => 1, + bindvals => [ + 'foo', + 'foo', + ] + }, + { + equal => 1, + bindvals => [ + 42, + 42, + '42', + ] + }, + + # scalarref - equal + { + equal => 1, + bindvals => [ + \'foo', + \'foo', + ] + }, + { + equal => 1, + bindvals => [ + \42, + \42, + \'42', + ] + }, + + # arrayref - equal + { + equal => 1, + bindvals => [ + [], + [] + ] + }, + { + equal => 1, + bindvals => [ + [42], + [42], + ['42'], + ] + }, + { + equal => 1, + bindvals => [ + [1, 42], + [1, 42], + ['1', 42], + [1, '42'], + ['1', '42'], + ] + }, + + # hashref - equal + { + equal => 1, + bindvals => [ + { foo => 42 }, + { foo => 42 }, + { foo => '42' }, + ] + }, + { + equal => 1, + bindvals => [ + { foo => 42, bar => 1 }, + { foo => 42, bar => 1 }, + { foo => '42', bar => 1 }, + ] + }, + + # blessed object - equal + { + equal => 1, + bindvals => [ + bless(\(local $_ = 42), 'Life::Universe::Everything'), + bless(\(local $_ = 42), 'Life::Universe::Everything'), + ] + }, + { + equal => 1, + bindvals => [ + bless([42], 'Life::Universe::Everything'), + bless([42], 'Life::Universe::Everything'), + ] + }, + { + equal => 1, + bindvals => [ + bless({ answer => 42 }, 'Life::Universe::Everything'), + bless({ answer => 42 }, 'Life::Universe::Everything'), + ] + }, + + # complex data structure - equal + { + equal => 1, + bindvals => [ + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + ] + }, + + + # scalar - different + { + equal => 0, + bindvals => [ + undef, + 'foo', + 42, + ] + }, + + # scalarref - different + { + equal => 0, + bindvals => [ + \undef, + \'foo', + \42, + ] + }, + + # arrayref - different + { + equal => 0, + bindvals => [ + [undef], + ['foo'], + [42], + ] + }, + + # hashref - different + { + equal => 0, + bindvals => [ + { foo => undef }, + { foo => 'bar' }, + { foo => 42 }, + ] + }, + + # different types + { + equal => 0, + bindvals => [ + 'foo', + \'foo', + ['foo'], + { foo => 'bar' }, + ] + }, + + # complex data structure - different + { + equal => 0, + bindvals => [ + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [43, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'baz', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { bar => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quuux => [1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [0, 1, 2, \3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, 3, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \4, { quux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quuux => [4, 5] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5, 6] } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quux => 4 } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5], quuux => 1 } ] }, 8 ], + [42, { foo => 'bar', quux => [1, 2, \3, { quux => [4, 5] } ] }, 8, 9 ], + ] + }, +); + + +plan tests => 1 + sum + map { $_ * ($_ - 1) / 2 } + map { scalar @{$_->{bindvals}} } + @bind_tests; + +use_ok('SQL::Abstract::Test', import => [qw(eq_sql eq_bind is_same_sql_bind)]); + +for my $test (@bind_tests) { + my $bindvals = $test->{bindvals}; + while (@$bindvals) { + my $bind1 = shift @$bindvals; + foreach my $bind2 (@$bindvals) { + my $equal = eq_bind($bind1, $bind2); + if ($test->{equal}) { + ok($equal, "equal bind values considered equal"); + } else { + ok(!$equal, "different bind values considered not equal"); + } + + if ($equal ^ $test->{equal}) { + diag("bind1: " . Dumper($bind1)); + diag("bind2: " . Dumper($bind2)); + } + } + } +}