[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