X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTest.pm;h=6ad4881e41dd75381eadaf5b0a421c154761ca6a;hb=bb54fcb44cb8362f47b6b1f5c26427b4204d0caa;hp=c511eee5acea43a1d2f6773fc01273021c749837;hpb=a24cc3a067fb9a58f93245b5848adbddad84454c;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm index c511eee..6ad4881 100644 --- a/lib/SQL/Abstract/Test.pm +++ b/lib/SQL/Abstract/Test.pm @@ -18,15 +18,6 @@ our $parenthesis_significant = 0; our $sql_differ; # keeps track of differing portion between SQLs our $tb = __PACKAGE__->builder; -# All of these keywords allow their parameters to be specified with or without parenthesis without changing the semantics -my @unrollable_ops = ( - 'ON', - 'WHERE', - 'GROUP \s+ BY', - 'HAVING', - 'ORDER \s+ BY', -); - sub is_same_sql_bind { my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_; @@ -141,6 +132,15 @@ sub _eq_sql { 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) { + return 1; + } # 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) ); @@ -157,7 +157,7 @@ sub _eq_sql { else { # unroll parenthesis if possible/allowed - _parenthesis_unroll ($_) for ($left, $right); + $parenthesis_significant || $sqlat->_parenthesis_unroll($_) for $left, $right; # if operators are different if ( $left->[0] ne $right->[0] ) { @@ -184,79 +184,7 @@ sub _eq_sql { } } -sub _parenthesis_unroll { - my $ast = shift; - - return if $parenthesis_significant; - return unless (ref $ast and ref $ast->[1]); - - my $changes; - do { - my @children; - $changes = 0; - - for my $child (@{$ast->[1]}) { - if (not ref $child or not $child->[0] eq 'PAREN') { - push @children, $child; - next; - } - - # unroll nested parenthesis - while ($child->[1][0][0] eq 'PAREN') { - $child = $child->[1][0]; - $changes++; - } - - # if the parenthesis are wrapped around an AND/OR matching the parent AND/OR - open the parenthesis up and merge the list - if ( - ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR') - and - $child->[1][0][0] eq $ast->[0] - ) { - push @children, @{$child->[1][0][1]}; - $changes++; - } - - # if the parent operator explcitly allows it nuke the parenthesis - elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) { - push @children, $child->[1][0]; - $changes++; - } - - # only one LITERAL element in the parenthesis - elsif ( - @{$child->[1]} == 1 && $child->[1][0][0] eq 'LITERAL' - ) { - push @children, $child->[1][0]; - $changes++; - } - - # only one element in the parenthesis which is a binary op with two LITERAL sub-children - elsif ( - @{$child->[1]} == 1 - and - grep { $child->[1][0][0] =~ /^ $_ $/xi } (SQL::Abstract::Tree::_binary_op_keywords()) - and - $child->[1][0][1][0][0] eq 'LITERAL' - and - $child->[1][0][1][1][0] eq 'LITERAL' - ) { - push @children, $child->[1][0]; - $changes++; - } - - # otherwise no more mucking for this pass - else { - push @children, $child; - } - } - - $ast->[1] = \@children; - - } while ($changes); - -} - +sub parse { $sqlat->parse(@_) } 1;