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

norbi at dev.catalyst.perl.org norbi at dev.catalyst.perl.org
Tue Nov 25 01:10:11 GMT 2008


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

Added:
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
Modified:
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/
   SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm
Log:
 r5226 at vger:  mendel | 2008-11-24 21:54:18 +0100
  * Added a few tests for SQLA::Test (some of them still fail).
  * Improved tokenizer and parser of SQLA::Test.



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:5202
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/SQL-Abstract/1.x/branches/1.50_RC-extraparens:5226

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-24 22:20:59 UTC (rev 5188)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/lib/SQL/Abstract/Test.pm	2008-11-25 01:10:11 UTC (rev 5189)
@@ -17,12 +17,10 @@
   my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
 
   # compare
-  my $tree1     = parse($sql1);
-  my $tree2     = parse($sql2);
-  my $same_sql  = eq_sql($tree1, $tree2);
+  my $same_sql  = eq_sql($sql1, $sql2);
   my $same_bind = eq_bind($bind_ref1, $bind_ref2);
 
-  # call Test::More::ok
+  # call Test::Builder::ok
   $tb->ok($same_sql && $same_bind, $msg);
 
   # add debugging info
@@ -69,6 +67,17 @@
 }
 
 sub eq_sql {
+  my ($sql1, $sql2) = @_;
+
+  # parse
+  my $tree1 = parse($sql1);
+  my $tree2 = parse($sql2);
+  warn Dumper($tree1, $tree2);  #FIXME debug
+
+  return _eq_sql($tree1, $tree2);
+}
+
+sub _eq_sql {
   my ($left, $right) = @_;
 
   # ignore top-level parentheses 
@@ -92,8 +101,8 @@
       return $eq;
     }
     else { # binary operator
-      return eq_sql($left->[1][0], $right->[1][0])  # left operand
-          && eq_sql($left->[1][1], $right->[1][1]); # right operand
+      return _eq_sql($left->[1][0], $right->[1][0])  # left operand
+          && _eq_sql($left->[1][1], $right->[1][1]); # right operand
     }
   }
 }
@@ -102,9 +111,39 @@
 sub parse {
   my $s = shift;
 
-  # tokenize string
-  my $tokens = [grep {!/^\s*$/} split /\s*(\(|\)|\bAND\b|\bOR\b)\s*/, $s];
+  my $tokenizer_re = qr/
+    \s*
+    (
+        \(
+      |
+        \)
+      |
+        \b AND \b
+      |
+        \b OR \b
+      |
+        \b ON \b
+      |
+        (?:
+          (?:
+              (?: \b (?: LEFT | RIGHT | FULL ) \s+ )?
+              (?: \b (?: CROSS | INNER | OUTER ) \s+ )?
+          )?
+          \b JOIN \b
+        )
+      |
+        \b WHERE \b
+    )
+    \s*
+  /x;
 
+  # tokenize string, and remove all optional whitespace
+  my $tokens = [
+    grep {!/^$/}
+      map { s/\s+/ /g; s/\s*([^\w\s]+)\s*/$1/g; $_ }
+        split $tokenizer_re, $s
+  ];
+
   my $tree = _recurse_parse($tokens);
   return $tree;
 }
@@ -133,6 +172,12 @@
       my $right = _recurse_parse($tokens);
       $left = [$token => [$left, $right]];
     }
+    # ON
+    elsif ($token eq 'ON') {
+      my $right = _recurse_parse($tokens);
+      $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
+                    : [PAREN  => $right];
+    }
     # leaf expression
     else {
       $left = $left ? [CONCAT => [$left, [EXPR => $token]]]

Added: SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	                        (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC-extraparens/t/10test.t	2008-11-25 01:10:11 UTC (rev 5189)
@@ -0,0 +1,289 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use List::Util qw(sum);
+
+use Test::More;
+
+
+my @sql_tests = (
+      # WHERE condition
+      {
+        equal => 1,
+        statements => [
+          q/SELECT foo FROM bar WHERE a = 1/,
+          q/SELECT foo FROM bar WHERE a=1/,
+          q/SELECT foo FROM bar WHERE (a = 1)/,
+          q/SELECT foo FROM bar WHERE (a=1)/,
+          q/SELECT foo FROM bar WHERE ( a = 1 )/,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              a = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              (a = 1)
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              ( a = 1 )
+          /,
+          q/SELECT foo FROM bar WHERE ((a = 1))/,
+          q/SELECT foo FROM bar WHERE ( (a = 1) )/,
+          q/SELECT foo FROM bar WHERE ( ( a = 1 ) )/,
+        ]
+      },
+      {
+        equal => 1,
+        statements => [
+          q/SELECT foo FROM bar WHERE a = 1 AND b = 1/,
+          q/SELECT foo FROM bar WHERE (a = 1) AND (b = 1)/,
+          q/SELECT foo FROM bar WHERE ((a = 1) AND (b = 1))/,
+          q/SELECT foo FROM bar WHERE (a = 1 AND b = 1)/,
+          q/SELECT foo FROM bar WHERE ((a = 1 AND b = 1))/,
+          q/SELECT foo FROM bar WHERE (((a = 1) AND (b = 1)))/,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              a = 1
+              AND
+              b = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              (a = 1
+              AND
+              b = 1)
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              (a = 1)
+              AND
+              (b = 1)
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            WHERE
+              ((a = 1)
+              AND
+              (b = 1))
+          /,
+        ]
+      },
+
+      # JOIN condition
+      {
+        equal => 1,
+        statements => [
+          q/SELECT foo FROM bar JOIN baz ON a = 1 WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON a=1 WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON (a = 1) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON (a=1) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON ( a = 1 ) WHERE x = 1/,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              a = 1
+            WHERE
+              x = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              (a = 1)
+            WHERE
+              x = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              ( a = 1 )
+            WHERE
+              x = 1
+          /,
+          q/SELECT foo FROM bar JOIN baz ON ((a = 1)) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON ( (a = 1) ) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON ( ( a = 1 ) ) WHERE x = 1/,
+        ]
+      },
+      {
+        equal => 1,
+        statements => [
+          q/SELECT foo FROM bar JOIN baz ON a = 1 AND b = 1 WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON (a = 1) AND (b = 1) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON ((a = 1) AND (b = 1)) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON (a = 1 AND b = 1) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON ((a = 1 AND b = 1)) WHERE x = 1/,
+          q/SELECT foo FROM bar JOIN baz ON (((a = 1) AND (b = 1))) WHERE x = 1/,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              a = 1
+              AND
+              b = 1
+            WHERE
+              x = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              (a = 1
+              AND
+              b = 1)
+            WHERE
+              x = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              (a = 1)
+              AND
+              (b = 1)
+            WHERE
+              x = 1
+          /,
+          q/
+            SELECT
+              foo
+            FROM
+              bar
+            JOIN
+              baz
+            ON
+              ((a = 1)
+              AND
+              (b = 1))
+            WHERE
+              x = 1
+          /,
+        ]
+      },
+
+      # DISTINCT ON (...) not confused with JOIN ON (...)
+      {
+        equal => 1,
+        statements => [
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE a = 1/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE a=1/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE (a = 1)/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE (a=1)/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE ( a = 1 )/,
+          q/
+            SELECT DISTINCT ON (foo, quux)
+              foo,
+              quux
+            FROM
+              bar
+            WHERE
+              a = 1
+          /,
+          q/
+            SELECT DISTINCT ON (foo, quux)
+              foo,
+              quux
+            FROM
+              bar
+            WHERE
+              (a = 1)
+          /,
+          q/
+            SELECT DISTINCT ON (foo, quux)
+              foo,
+              quux
+            FROM
+              bar
+            WHERE
+              ( a = 1 )
+          /,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE ((a = 1))/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE ( (a = 1) )/,
+          q/SELECT DISTINCT ON (foo, quux) foo, quux FROM bar WHERE ( ( a = 1 ) )/,
+        ]
+      },
+);
+
+
+plan tests => 1 + sum
+  map { $_ * ($_ + 1) / 2 }
+    map { scalar @{$_->{statements}} }
+      @sql_tests;
+
+use_ok('SQL::Abstract::Test', import => [qw(eq_sql eq_bind is_same_sql_bind)]);
+
+for my $test (@sql_tests) {
+  my $statements = $test->{statements};
+  while (@$statements) {
+    my $sql1 = $statements->[0];
+    foreach my $sql2 (@$statements) {
+      my $equal = eq_sql($sql1, $sql2);
+      if ($test->{equal}) {
+        ok($equal, "equal SQL expressions considered equal");
+      } else {
+        ok(!$equal, "different SQL expressions considered not equal");
+      }
+
+      if ($equal ^ $test->{equal}) {
+        diag("sql1: $sql1");
+        diag("sql2: $sql2");
+      }
+    }
+    shift @$statements;
+  }
+}




More information about the Bast-commits mailing list