[Bast-commits] r5190 - in SQL-Abstract/1.x/branches/1.50_RC-extraparens: . lib/SQL/Abstract t

[norbi at dev.catalyst.perl.org]

Author: norbi
Date: 2008-11-25 01:10:17 +0000 (Tue, 25 Nov 2008)
New Revision: 5190

Modified:
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
Log:
 r5240 at vger:  mendel | 2008-11-25 02:09:59 +0100
  * WIP: improving the SQLA::Test parser.



Property changes on: SQL-Abstract/1.x/branches/1.50_RC-extraparens
___________________________________________________________________
Name: svk:merge
   - 4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC:5202
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC-extraparens:5226
   + 4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC:5202
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC-extraparens:5240

Modified: SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm	2008-11-25 01:10:11 UTC (rev 5189)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm	2008-11-25 01:10:17 UTC (rev 5190)
@@ -133,9 +133,14 @@
         )
       |
         \b WHERE \b
+      |
+        \b GROUP\sBY \b
+        \b ORDER\sBY \b
+        \b LIMIT \b
+        \b OFFSET \b
     )
     \s*
-  /x;
+  /xi;
 
   # tokenize string, and remove all optional whitespace
   my $tokens = [
@@ -172,11 +177,12 @@
       my $right = _recurse_parse($tokens);
       $left = [$token => [$left, $right]];
     }
-    # ON
-    elsif ($token eq 'ON') {
+    # ON, WHERE, GROUP BY, ORDER BY, LIMIT, OFFSET
+    elsif (grep { $token eq $_ }
+      ('ON', 'WHERE', 'GROUP BY', 'ORDER BY', 'LIMIT', 'OFFSET')) {
       my $right = _recurse_parse($tokens);
-      $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
-                    : [PAREN  => $right];
+      $left = $left ? [CONCAT => [$left, [CONCAT => [[EXPR => $token], [PAREN => $right]]]]]
+                    : [CONCAT => [[EXPR => $token], [PAREN  => $right]]];
     }
     # leaf expression
     else {

Modified: SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	2008-11-25 01:10:11 UTC (rev 5189)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	2008-11-25 01:10:17 UTC (rev 5190)
@@ -8,7 +8,7 @@
 
 
 my @sql_tests = (
-      # WHERE condition
+      # WHERE condition - equal
       {
         equal => 1,
         statements => [
@@ -98,6 +98,48 @@
         ]
       },
 
+      # WHERE condition - different
+      {
+        equal => 0,
+        statements => [
+          q/SELECT foo FROM bar WHERE a = 1/,
+          q/SELECT quux FROM bar WHERE a = 1/,
+          q/SELECT foo FROM quux WHERE a = 1/,
+          q/FOOBAR foo FROM bar WHERE a = 1/,
+          q/SELECT foo FROM bar WHERE b = 1/,
+          q/SELECT foo FROM bar WHERE a = 2/,
+          q/SELECT foo FROM bar WHERE a = 1 AND quux/,
+          q/SELECT foo FROM bar WHERE a = 1 GROUP BY foo/,
+          q/SELECT foo FROM bar WHERE a = 1 ORDER BY foo/,
+          q/SELECT foo FROM bar WHERE a = 1 LIMIT 1/,
+          q/SELECT foo FROM bar WHERE a = 1 OFFSET 1/,
+          q/SELECT foo FROM bar JOIN quux WHERE a = 1/,
+          q/SELECT foo FROM bar JOIN quux ON b = foo WHERE a = 1/,
+          q/SELECT foo FROM bar JOIN quux ON (c = foo) WHERE a = 1/,
+          q/SELECT foo FROM bar WHERE (c = 1)/,
+        ]
+      },
+      {
+        equal => 0,
+        statements => [
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar WHERE a = 1 AND a = 1/,
+          q/SELECT foo FROM bar WHERE (b = 1 AND b = 1)/,
+          q/SELECT quux FROM bar WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM quux WHERE a = 1 AND b = 1/,
+          q/FOOBAR foo FROM bar WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar WHERE a = 2 AND b = 1/,
+          q/SELECT foo FROM bar WHERE a = 1 AND quux AND b = 1/,
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1 GROUP BY foo/,
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1 ORDER BY foo/,
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1 LIMIT 1/,
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1 OFFSET 1/,
+          q/SELECT foo FROM bar JOIN quux WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar JOIN quux ON b = foo WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar JOIN quux ON (c = foo) WHERE a = 1 AND b = 1/,
+        ]
+      },
+
       # JOIN condition
       {
         equal => 1,
@@ -261,7 +303,7 @@
 
 
 plan tests => 1 + sum
-  map { $_ * ($_ + 1) / 2 }
+  map { $_ * ($_ - 1) / 2 }
     map { scalar @{$_->{statements}} }
       @sql_tests;
 
@@ -270,7 +312,7 @@
 for my $test (@sql_tests) {
   my $statements = $test->{statements};
   while (@$statements) {
-    my $sql1 = $statements->[0];
+    my $sql1 = shift @$statements;
     foreach my $sql2 (@$statements) {
       my $equal = eq_sql($sql1, $sql2);
       if ($test->{equal}) {
@@ -284,6 +326,5 @@
         diag("sql2: $sql2");
       }
     }
-    shift @$statements;
   }
 }