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 (file)
--- 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 <function> 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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';