Fix SQLA::Test problem
Peter Rabbitson [Sun, 30 May 2010 09:24:43 +0000 (09:24 +0000)]
Changes
lib/SQL/Abstract/Test.pm
t/10test.t

diff --git a/Changes b/Changes
index 82dff07..632f414 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for SQL::Abstract
 
+    - Fix SQL::Test failure when first chunk is an unrecognized
+      literal
+    - Generic -not operator tests
+
 revision 1.66  2010-04-27 02:44 (UTC)
 ----------------------------
     - Optimized the quoting mechanism, winning nearly 10%
index 16450b7..52489a8 100644 (file)
@@ -284,6 +284,7 @@ sub _recurse_parse {
       my $right = _recurse_parse($tokens, PARSE_IN_PARENS);
       $token = shift @$tokens   or croak "missing closing ')' around block " . unparse ($right);
       $token eq ')'             or croak "unexpected token '$token' terminating block " . unparse ($right);
+
       $left = $left ? [@$left, [PAREN => [$right] ]]
                     : [PAREN  => [$right] ];
     }
@@ -318,21 +319,21 @@ sub _recurse_parse {
     elsif (grep { $token =~ /^ $_ $/xi } @expression_terminator_sql_keywords ) {
       my $op = uc $token;
       my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
-      $left = $left ? [@$left,  [$op => [$right] ]]
-                    : [[ $op => [$right] ]];
+      $left = $left ? [ $left,  [$op => [$right] ]]
+                    : [ $op => [$right] ];
     }
     # NOT (last as to allow all other NOT X pieces first)
     elsif ( $token =~ /^ not $/ix ) {
       my $op = uc $token;
       my $right = _recurse_parse ($tokens, PARSE_RHS);
       $left = $left ? [ @$left, [$op => [$right] ]]
-                    : [[ $op => [$right] ]];
+                    : [ $op => [$right] ];
 
     }
     # literal (eat everything on the right until RHS termination)
     else {
       my $right = _recurse_parse ($tokens, PARSE_RHS);
-      $left = $left ? [$left, [LITERAL => [join ' ', $token, unparse($right)||()] ] ]
+      $left = $left ? [ $left, [LITERAL => [join ' ', $token, unparse($right)||()] ] ]
                     : [ LITERAL => [join ' ', $token, unparse($right)||()] ];
     }
   }
index 0d5e1de..2a75d32 100644 (file)
@@ -6,6 +6,10 @@ use List::Util qw(sum);
 
 use Test::More;
 
+use Data::Dumper;
+$Data::Dumper::Terse = 1;
+$Data::Dumper::Sortkeys = 1;
+
 # equivalent to $Module::Install::AUTHOR
 my $author = (
   ( not -d './inc' )
@@ -542,6 +546,13 @@ my @sql_tests = (
       {
         equal => 0,
         statements => [
+          q/DELETE FROM cd WHERE ( cdid IN ( SELECT me.cdid FROM (SELECT * FROM cd me WHERE ( year != ? ) GROUP BY me.cdid) me WHERE ( year != ? ) ) )/,
+          q/DELETE FROM cd WHERE ( cdid IN ( SELECT me.cdid FROM cd me WHERE ( year != ? ) GROUP BY me.cdid ) )/,
+        ],
+      },
+      {
+        equal => 0,
+        statements => [
           q/SELECT * FROM (SELECT * FROM bar WHERE b = 1) AS foo WHERE a = 1/,
           q/SELECT * FROM (SELECT * FROM bar WHERE b = 1) AS foo WHERE a = 2/,
           q/SELECT * FROM (SELECT * FROM bar WHERE b = 1) AS foo WHERE (a = 3)/,
@@ -847,6 +858,8 @@ for my $test (@sql_tests) {
         if ($equal ^ $test->{equal}) {
           diag("sql1: $sql1");
           diag("sql2: $sql2");
+          note('ast1: ' . Dumper SQL::Abstract::Test::parse ($sql1));
+          note('ast2: ' . Dumper SQL::Abstract::Test::parse ($sql2));
         }
       }
     }