Reimplemented SQL::Abstract::Test::eq_bind to compare the data structures instead...

Added tests for eq_bind.

diff --git a/MANIFEST b/MANIFEST
index 039267f..9503a39 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -12,5 +12,4 @@ t/06order_by.t
 t/07subqueries.t\r
 t/08special_ops.t\r
 t/09refkind.t\r
-\r
-\r
+t/10test.t\r

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index 55c2e99..49f7800 100644 (file)
--- 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<SQL::Abstract/bindtype>),
-  # so stringify them.
-  # furthermore, if L<SQL::Abstract/array_datatypes> 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 (file)
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));
+      }
+    }
+  }
+}