[Bast-commits] r9457 - in SQL-Abstract/1.x/trunk: . lib/SQL/Abstract t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Sun May 30 09:24:43 GMT 2010


Author: ribasushi
Date: 2010-05-30 10:24:43 +0100 (Sun, 30 May 2010)
New Revision: 9457

Modified:
   SQL-Abstract/1.x/trunk/Changes
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract/Test.pm
   SQL-Abstract/1.x/trunk/t/10test.t
Log:
Fix SQLA::Test problem

Modified: SQL-Abstract/1.x/trunk/Changes
===================================================================
--- SQL-Abstract/1.x/trunk/Changes	2010-05-28 21:03:53 UTC (rev 9456)
+++ SQL-Abstract/1.x/trunk/Changes	2010-05-30 09:24:43 UTC (rev 9457)
@@ -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%

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract/Test.pm	2010-05-28 21:03:53 UTC (rev 9456)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract/Test.pm	2010-05-30 09:24:43 UTC (rev 9457)
@@ -284,6 +284,7 @@
       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 @@
     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)||()] ];
     }
   }

Modified: SQL-Abstract/1.x/trunk/t/10test.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/10test.t	2010-05-28 21:03:53 UTC (rev 9456)
+++ SQL-Abstract/1.x/trunk/t/10test.t	2010-05-30 09:24:43 UTC (rev 9457)
@@ -6,6 +6,10 @@
 
 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 @@
       {
         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 @@
         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));
         }
       }
     }




More information about the Bast-commits mailing list