X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTest.pm;h=202d1307a39a6fce9d95cd62c16d1e39e5540a87;hb=0c2de280869928d9ff1ee95f36a9a45318766990;hp=6ad4881e41dd75381eadaf5b0a421c154761ca6a;hpb=bb54fcb44cb8362f47b6b1f5c26427b4204d0caa;p=dbsrgits%2FSQL-Abstract.git

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index 6ad4881..202d130 100644
--- a/lib/SQL/Abstract/Test.pm
+++ b/lib/SQL/Abstract/Test.pm
@@ -5,6 +5,7 @@ use warnings;
 use base qw/Test::Builder::Module Exporter/;
 use Data::Dumper;
 use Test::Builder;
+use Test::Deep ();
 use SQL::Abstract::Tree;
 
 our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
@@ -15,6 +16,8 @@ my $sqlat = SQL::Abstract::Tree->new;
 
 our $case_sensitive = 0;
 our $parenthesis_significant = 0;
+our $order_by_asc_significant = 0;
+
 our $sql_differ; # keeps track of differing portion between SQLs
 our $tb = __PACKAGE__->builder;
 
@@ -102,14 +105,7 @@ sub eq_sql_bind {
 }
 
 
-sub eq_bind {
-  my ($bind_ref1, $bind_ref2) = @_;
-
-  local $Data::Dumper::Useqq = 1;
-  local $Data::Dumper::Sortkeys = 1;
-
-  return Dumper($bind_ref1) eq Dumper($bind_ref2);
-}
+sub eq_bind { goto &Test::Deep::eq_deeply };
 
 sub eq_sql {
   my ($sql1, $sql2) = @_;
@@ -118,6 +114,7 @@ sub eq_sql {
   my $tree1 = $sqlat->parse($sql1);
   my $tree2 = $sqlat->parse($sql2);
 
+  undef $sql_differ;
   return 1 if _eq_sql($tree1, $tree2);
 }
 
@@ -126,60 +123,85 @@ sub _eq_sql {
 
   # one is defined the other not
   if ( (defined $left) xor (defined $right) ) {
+    $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse ($_) : 'N/A' } ($left, $right) );
     return 0;
   }
+
   # one is undefined, then so is the other
   elsif (not defined $left) {
     return 1;
   }
-  # different amount of elements
-  elsif (@$left != @$right) {
-    $sql_differ = sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
-    return 0;
-  }
-  # one is empty - so is the other
-  elsif (@$left == 0) {
+
+  # both are empty
+  elsif (@$left == 0 and @$right == 0) {
     return 1;
   }
+
+  # one is empty
+  if (@$left == 0 or @$right == 0) {
+    $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse ($_) : 'N/A'} ($left, $right) );
+    return 0;
+  }
+
   # one is a list, the other is an op with a list
   elsif (ref $left->[0] xor ref $right->[0]) {
-    $sql_differ = sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
+    $sql_differ = sprintf ("[%s] != [%s]\nleft: %s\nright: %s\n", map
+      { ref $_ ? $sqlat->unparse ($_) : $_ }
+      ($left->[0], $right->[0], $left, $right)
+    );
     return 0;
   }
-  # one is a list, so is the other
+
+  # both are lists
   elsif (ref $left->[0]) {
     for (my $i = 0; $i <= $#$left or $i <= $#$right; $i++ ) {
-      return 0 if (not _eq_sql ($left->[$i], $right->[$i]) );
+      if (not _eq_sql ($left->[$i], $right->[$i]) ) {
+        if (! $sql_differ or $sql_differ !~ /left\:\s .+ right:\s/xs) {
+          $sql_differ ||= '';
+          $sql_differ .= "\n" unless $sql_differ =~ /\n\z/;
+          $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
+        }
+        return 0;
+      }
     }
     return 1;
   }
-  # both are an op-list combo
+
+  # both are ops
   else {
 
     # unroll parenthesis if possible/allowed
-    $parenthesis_significant || $sqlat->_parenthesis_unroll($_) for $left, $right;
+    unless ( $parenthesis_significant ) {
+      $sqlat->_parenthesis_unroll($_) for $left, $right;
+    }
+
+    # unroll ASC order by's
+    unless ($order_by_asc_significant) {
+      $sqlat->_strip_asc_from_order_by($_) for $left, $right;
+    }
 
-    # if operators are different
     if ( $left->[0] ne $right->[0] ) {
       $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
         $sqlat->unparse($left),
-        $sqlat->unparse($right);
+        $sqlat->unparse($right)
+      ;
       return 0;
     }
-    # elsif operators are identical, compare operands
+
+    # literals have a different arg-sig
+    elsif ($left->[0] eq '-LITERAL') {
+      (my $l = " $left->[1][0] " ) =~ s/\s+/ /g;
+      (my $r = " $right->[1][0] ") =~ s/\s+/ /g;
+      my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r);
+      $sql_differ = "[$l] != [$r]\n" if not $eq;
+      return $eq;
+    }
+
+    # if operators are identical, compare operands
     else {
-      if ($left->[0] eq 'LITERAL' ) { # unary
-        (my $l = " $left->[1][0] " ) =~ s/\s+/ /g;
-        (my $r = " $right->[1][0] ") =~ s/\s+/ /g;
-        my $eq = $case_sensitive ? $l eq $r : uc($l) eq uc($r);
-        $sql_differ = "[$l] != [$r]\n" if not $eq;
-        return $eq;
-      }
-      else {
-        my $eq = _eq_sql($left->[1], $right->[1]);
-        $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
-        return $eq;
-      }
+      my $eq = _eq_sql($left->[1], $right->[1]);
+      $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
+      return $eq;
     }
   }
 }
@@ -308,7 +330,13 @@ If true, SQL comparisons will be case-sensitive. Default is false;
 =head2 $parenthesis_significant
 
 If true, SQL comparison will preserve and report difference in nested
-parenthesis. Useful for testing the C<-nest> modifier. Defaults to false;
+parenthesis. Useful while testing C<IN (( x ))> vs C<IN ( x )>.
+Defaults to false;
+
+=head2 $order_by_asc_significant
+
+If true SQL comparison will consider C<ORDER BY foo ASC> and
+C<ORDER BY foo> to be different. Default is false;
 
 =head2 $sql_differ