From: Peter Rabbitson Date: Tue, 17 Dec 2013 23:33:31 +0000 (+0100) Subject: And yet more improvements in the parsing engine X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b4085a1a3c815de38ac86ca9e0bab01110b48c7e;p=scpubgit%2FQ-Branch.git And yet more improvements in the parsing engine Streamline the construction of -MISC (gah I hate that name) nodes, and make sure we do not treat placeholders as list element node terminator --- diff --git a/Changes b/Changes index c3d7ddc..cbe7d4b 100644 --- a/Changes +++ b/Changes @@ -6,6 +6,7 @@ Revision history for SQL::Abstract but subtle changes to query results in production - Fix false negative comparison of ORDER BY ASC + - More improvements of incorrect parsing (literal at end of list elt) - Fix typos in POD and comments (RT#87776) revision 1.74 2013-06-04 diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm index 5b1cbfe..f826ba7 100644 --- a/lib/SQL/Abstract/Tree.pm +++ b/lib/SQL/Abstract/Tree.pm @@ -169,7 +169,8 @@ for ( $_ = qr/ \A $_ \z /x; } - +# what can be bunched together under one MISC in an AST +my $compressable_node_re = qr/^ \- (?: MISC | LITERAL | PLACEHOLDER ) $/x; my %indents = ( select => 0, @@ -453,6 +454,8 @@ sub _recurse_parse { else { my @lits = [ -LITERAL => [$token] ]; + unshift @lits, pop @left if @left == 1; + unless ( $state == PARSE_RHS ) { while ( @$tokens @@ -462,27 +465,38 @@ sub _recurse_parse { ! ( @$tokens > 1 and $tokens->[1] eq '(' ) ) { push @lits, [ -LITERAL => [ shift @$tokens ] ]; - } + } } - if (@left == 1) { - unshift @lits, pop @left; - } - @lits = [ -MISC => [ @lits ] ] if @lits > 1; push @left, @lits; } - if (@$tokens) { + # compress -LITERAL -MISC and -PLACEHOLDER pieces into a single + # -MISC container + if (@left > 1) { + my $i = 0; + while ($#left > $i) { + if ($left[$i][0] =~ $compressable_node_re and $left[$i+1][0] =~ $compressable_node_re) { + splice @left, $i, 2, [ -MISC => [ + map { $_->[0] eq '-MISC' ? @{$_->[1]} : $_ } (@left[$i, $i+1]) + ]]; + } + else { + $i++; + } + } + } + + return @left if $state == PARSE_RHS; - # deal with post-fix operators (asc/desc) + # deal with post-fix operators + if (@$tokens) { + # asc/desc if ($tokens->[0] =~ $asc_desc_re) { - return @left if $state == PARSE_RHS; @left = [ ('-' . uc (shift @$tokens)) => [ @left ] ]; } - - return @left if $state == PARSE_RHS and $left[-1][0] eq '-LITERAL'; } } } diff --git a/t/10test.t b/t/10test.t index 2132740..736940c 100644 --- a/t/10test.t +++ b/t/10test.t @@ -618,6 +618,13 @@ my @sql_tests = ( ], }, { + equal => 1, + statements => [ + q/ORDER BY name + ?, [me].[id]/, + q/ORDER BY name + ? ASC, [me].[id]/, + ], + }, + { equal => 0, opts => { order_by_asc_significant => 1 }, statements => [ @@ -964,7 +971,7 @@ use_ok('SQL::Abstract::Test', import => [qw( eq_sql_bind eq_sql eq_bind is_same_sql_bind )]); -for my $test (@sql_tests) { +for my $test ( @sql_tests ) { # this does not work on 5.8.8 and earlier :( #local @{*SQL::Abstract::Test::}{keys %{$test->{opts}}} = map { \$_ } values %{$test->{opts}} diff --git a/t/11parser.t b/t/11parser.t index eaf5616..7cf6509 100644 --- a/t/11parser.t +++ b/t/11parser.t @@ -665,15 +665,15 @@ is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? D [ "+" ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] ] ] ], - [ - "-PLACEHOLDER", - [ - "?" - ] - ] ] ], [ @@ -699,15 +699,15 @@ is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? D [ "-" ] - ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] + ], ] ], - [ - "-PLACEHOLDER", - [ - "?" - ] - ] ] ], [ @@ -733,15 +733,15 @@ is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? D [ "/" ] - ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] + ], ] ], - [ - "-PLACEHOLDER", - [ - "?" - ] - ] ] ], [ @@ -959,45 +959,45 @@ is_deeply( $sqlat->parse("META SELECT * * FROM (SELECT *, FROM foobar baz buzz) ] ], [ - "=", + "-MISC", [ [ - "-LITERAL", - [ - "foo.a" - ] - ], - [ - "-MISC", + "=", [ [ - "-PLACEHOLDER", + "-LITERAL", [ - "?" + "foo.a" ] ], [ - "-LITERAL", + "-PLACEHOLDER", [ - "STUFF" + "?" ] - ] + ], ], ], [ - 'moar', + "-LITERAL", + [ + "STUFF" + ] + ], + ], + ], + [ + 'moar', + [ + [ + '-PAREN', [ [ - '-PAREN', + '-LITERAL', [ - [ - '-LITERAL', - [ - 'stuff' - ] - ] + 'stuff' ] - ] + ] ] ] ] diff --git a/t/14roundtrippin.t b/t/14roundtrippin.t index c898572..7e0fda9 100644 --- a/t/14roundtrippin.t +++ b/t/14roundtrippin.t @@ -4,6 +4,10 @@ use strict; use Test::More; use Test::Exception; +use Data::Dumper; +$Data::Dumper::Terse = 1; +$Data::Dumper::Sortkeys = 1; + use SQL::Abstract::Test import => ['is_same_sql']; use SQL::Abstract::Tree; @@ -24,6 +28,7 @@ my @sql = ( "SELECT foo AS bar FROM baz ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC", "SELECT inner_forum_roles.forum_id FROM forum_roles AS inner_forum_roles LEFT JOIN user_roles AS inner_user_roles USING(user_role_type_id) WHERE inner_user_roles.user_id = users__row.user_id", "SELECT * FROM foo WHERE foo.a @@ to_tsquery('word')", + "SELECT * FROM foo ORDER BY name + ?, [me].[id]", ); # FIXME FIXME FIXME @@ -55,7 +60,16 @@ for my $orig (@sql) { $_ =~ s/\s*([\(\)])\s*/$1 /g for ($orig, $reassembled); - is (lc($reassembled), lc($orig), sprintf 'roundtrip works (%s...)', substr $orig, 0, 20); + is ( + lc($reassembled), + lc($orig), + sprintf( 'roundtrip works (%s...)', substr $orig, 0, 20 ) + ) or do { + my ($ast1, $ast2) = map { Dumper $sqlat->parse($_) } ( $orig, $reassembled ); + + note "ast1: $ast1"; + note "ast2: $ast2"; + }; } lives_ok { $sqlat->unparse( $sqlat->parse( <<'EOS' ) ) } 'Able to parse/unparse grossly malformed sql';