[Bast-commits] r6008 - in SQL-Abstract/1.x/branches/and_or: .
lib/SQL lib/SQL/Abstract t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Tue Apr 28 22:01:31 GMT 2009
Author: ribasushi
Date: 2009-04-28 23:01:31 +0100 (Tue, 28 Apr 2009)
New Revision: 6008
Added:
SQL-Abstract/1.x/branches/and_or/t/05between.t
Modified:
SQL-Abstract/1.x/branches/and_or/
SQL-Abstract/1.x/branches/and_or/Changes
SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract.pm
SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract/Test.pm
SQL-Abstract/1.x/branches/and_or/t/04modifiers.t
SQL-Abstract/1.x/branches/and_or/t/06order_by.t
SQL-Abstract/1.x/branches/and_or/t/10test.t
Log:
r5918 at Thesaurus (orig r5917): arcanez | 2009-04-21 02:03:47 +0200
patch for -between to handle [\"", \""] and \["", @bind] with accompanying tests
r5922 at Thesaurus (orig r5921): ribasushi | 2009-04-21 08:30:25 +0200
Silence warning on bleadperl (by SMPETERS)
r5982 at Thesaurus (orig r5981): arcanez | 2009-04-24 20:47:06 +0200
add support for order_by => [qw/colA colB/]
r5983 at Thesaurus (orig r5982): arcanez | 2009-04-24 20:54:00 +0200
add in my changes
r5985 at Thesaurus (orig r5984): ribasushi | 2009-04-24 21:53:07 +0200
Make POD more readable, add a (failing) multikey order_by test
r5986 at Thesaurus (orig r5985): ribasushi | 2009-04-24 23:17:32 +0200
Wrap up order_by saga
r5994 at Thesaurus (orig r5993): arcanez | 2009-04-28 08:45:31 +0200
patch to suppress warnings in case first element of the arrayref is undef (NULL)
r5998 at Thesaurus (orig r5997): ribasushi | 2009-04-28 15:27:33 +0200
Refactor the parenthesis unroll SQLA::Test code
Allow explicit override: $SQL::Abstract::Test::parenthesis_significant
r5999 at Thesaurus (orig r5998): ribasushi | 2009-04-28 15:29:52 +0200
Add -nest tests by ldami
r6000 at Thesaurus (orig r5999): ribasushi | 2009-04-28 15:36:56 +0200
Disable t/10test.t for ordinary users (suggested by ldami)
r6001 at Thesaurus (orig r6000): dami | 2009-04-28 18:17:07 +0200
test -nest inside an arrayref
r6002 at Thesaurus (orig r6001): ribasushi | 2009-04-28 18:52:12 +0200
Parenthesis do matter in -nest tests
Property changes on: SQL-Abstract/1.x/branches/and_or
___________________________________________________________________
Name: svk:merge
- b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
+ b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/trunk:6001
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/SQL-Abstract:3093
Modified: SQL-Abstract/1.x/branches/and_or/Changes
===================================================================
--- SQL-Abstract/1.x/branches/and_or/Changes 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/Changes 2009-04-28 22:01:31 UTC (rev 6008)
@@ -1,5 +1,8 @@
Revision history for SQL::Abstract
+ - allow -between to handle [\"", \""] and \["", @bind]
+ - allow order_by to handle -asc|desc => [qw/colA colB/]
+
----------------------------
revision 1.51 2009-03-28 10:00 (UTC)
- fixed behavior of [-and => ... ] depending on the current
Modified: SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract/Test.pm 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract/Test.pm 2009-04-28 22:01:31 UTC (rev 6008)
@@ -13,6 +13,7 @@
$case_sensitive $sql_differ/;
our $case_sensitive = 0;
+our $parenthesis_significant = 0;
our $sql_differ; # keeps track of differing portion between SQLs
our $tb = __PACKAGE__->builder;
@@ -203,69 +204,9 @@
# both are an op-list combo
else {
- for my $ast ($left, $right) {
+ # unroll parenthesis if possible/allowed
+ _parenthesis_unroll ($_) for ($left, $right);
- next unless (ref $ast->[1]);
-
- # unroll parenthesis in an elaborate loop
- my $changes;
- do {
-
- my @children;
- $changes = 0;
-
- for my $child (@{$ast->[1]}) {
- if (not ref $child or not $child->[0] eq 'PAREN') {
- push @children, $child;
- next;
- }
-
- # unroll nested parenthesis
- while ($child->[1][0][0] eq 'PAREN') {
- $child = $child->[1][0];
- $changes++;
- }
-
- # if the parenthesis are wrapped around an AND/OR matching the parent AND/OR - open the parenthesis up and merge the list
- if (
- ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR')
- and
- $child->[1][0][0] eq $ast->[0]
- ) {
- push @children, @{$child->[1][0][1]};
- $changes++;
- }
-
- # if the parent operator explcitly allows it nuke the parenthesis
- elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) {
- push @children, $child->[1][0];
- $changes++;
- }
-
- # only one element in the parenthesis which is a binary op with two EXPR sub-children
- elsif (
- @{$child->[1]} == 1
- and
- grep { $child->[1][0][0] =~ /^ $_ $/xi } (@binary_op_keywords)
- and
- $child->[1][0][1][0][0] eq 'EXPR'
- and
- $child->[1][0][1][1][0] eq 'EXPR'
- ) {
- push @children, $child->[1][0];
- $changes++;
- }
-
- # otherwise no more mucking for this pass
- else {
- push @children, $child;
- }
- }
-
- $ast->[1] = \@children;
- } while ($changes);
- }
-
# if operators are different
if ($left->[0] ne $right->[0]) {
$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
@@ -291,7 +232,6 @@
}
}
-
sub parse {
my $s = shift;
@@ -378,8 +318,71 @@
}
}
+sub _parenthesis_unroll {
+ my $ast = shift;
+ return if $parenthesis_significant;
+ return unless (ref $ast and ref $ast->[1]);
+ my $changes;
+ do {
+ my @children;
+ $changes = 0;
+
+ for my $child (@{$ast->[1]}) {
+ if (not ref $child or not $child->[0] eq 'PAREN') {
+ push @children, $child;
+ next;
+ }
+
+ # unroll nested parenthesis
+ while ($child->[1][0][0] eq 'PAREN') {
+ $child = $child->[1][0];
+ $changes++;
+ }
+
+ # if the parenthesis are wrapped around an AND/OR matching the parent AND/OR - open the parenthesis up and merge the list
+ if (
+ ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR')
+ and
+ $child->[1][0][0] eq $ast->[0]
+ ) {
+ push @children, @{$child->[1][0][1]};
+ $changes++;
+ }
+
+ # if the parent operator explcitly allows it nuke the parenthesis
+ elsif ( grep { $ast->[0] =~ /^ $_ $/xi } @unrollable_ops ) {
+ push @children, $child->[1][0];
+ $changes++;
+ }
+
+ # only one element in the parenthesis which is a binary op with two EXPR sub-children
+ elsif (
+ @{$child->[1]} == 1
+ and
+ grep { $child->[1][0][0] =~ /^ $_ $/xi } (@binary_op_keywords)
+ and
+ $child->[1][0][1][0][0] eq 'EXPR'
+ and
+ $child->[1][0][1][1][0] eq 'EXPR'
+ ) {
+ push @children, $child->[1][0];
+ $changes++;
+ }
+
+ # otherwise no more mucking for this pass
+ else {
+ push @children, $child;
+ }
+ }
+
+ $ast->[1] = \@children;
+
+ } while ($changes);
+
+}
+
sub unparse {
my $tree = shift;
@@ -520,6 +523,11 @@
If true, SQL comparisons will be case-sensitive. Default is false;
+=head2 $parenthesis_significant
+
+If true, SQL comparison will preserve and report difference in nested
+parenthesis. Useful for testing the C<-nest> modifier. Defaults to false;
+
=head2 $sql_differ
When L</eq_sql> returns false, the global variable
Modified: SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract.pm 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/lib/SQL/Abstract.pm 2009-04-28 22:01:31 UTC (rev 6008)
@@ -63,7 +63,7 @@
delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
# default logic for interpreting arrayrefs
- $opt{logic} = uc $opt{logic} || 'OR';
+ $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
# how to return bind vars
# LDNOTE: changed nwiger code : why this 'delete' ??
@@ -505,9 +505,10 @@
$self->_debug("ARRAY($k) means distribute over elements");
# put apart first element if it is an operator (-and, -or)
- my $op = ($v[0] =~ /^ - (?: AND|OR ) $/ix
- ? shift @v
- : ''
+ my $op = (
+ (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
+ ? shift @v
+ : ''
);
my @distributed = map { {$k => $_} } @v;
@@ -711,16 +712,39 @@
sub _where_field_BETWEEN {
my ($self, $k, $op, $vals) = @_;
- ref $vals eq 'ARRAY' && @$vals == 2
- or puke "special op 'between' requires an arrayref of two values";
+ (ref $vals eq 'ARRAY' && @$vals == 2) or
+ (ref $vals eq 'REF' && (@$$vals == 1 || @$$vals == 2 || @$$vals == 3))
+ or puke "special op 'between' requires an arrayref of two values (or a scalarref or arrayrefref for literal SQL)";
- my ($label) = $self->_convert($self->_quote($k));
- my ($placeholder) = $self->_convert('?');
- my $and = $self->_sqlcase('and');
+ my ($clause, @bind, $label, $and, $placeholder);
+ $label = $self->_convert($self->_quote($k));
+ $and = ' ' . $self->_sqlcase('and') . ' ';
+ $placeholder = $self->_convert('?');
$op = $self->_sqlcase($op);
- my $sql = "( $label $op $placeholder $and $placeholder )";
- my @bind = $self->_bindtype($k, @$vals);
+ if (ref $vals eq 'REF') {
+ ($clause, @bind) = @$$vals;
+ }
+ else {
+ my (@all_sql, @all_bind);
+
+ foreach my $val (@$vals) {
+ my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+ SCALAR => sub {
+ return ($placeholder, ($val));
+ },
+ SCALARREF => sub {
+ return ($self->_convert($$val), ());
+ },
+ });
+ push @all_sql, $sql;
+ push @all_bind, @bind;
+ }
+
+ $clause = (join $and, @all_sql);
+ @bind = $self->_bindtype($k, @all_bind);
+ }
+ my $sql = "( $label $op $clause )";
return ($sql, @bind)
}
@@ -814,7 +838,8 @@
my ($order) = ($key =~ /^-(desc|asc)/i)
or puke "invalid key in _order_by hash : $key";
- return $self->_quote($val) ." ". $self->_sqlcase($order);
+ $val = ref $val eq 'ARRAY' ? $val : [$val];
+ return join ', ', map { $self->_quote($_) . ' ' . $self->_sqlcase($order) } @$val;
}
@@ -2070,19 +2095,29 @@
column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
or an array of either of the two previous forms. Examples:
- Given | Will Generate
+ Given | Will Generate
----------------------------------------------------------
- \'colA DESC' | ORDER BY colA DESC
- 'colA' | ORDER BY colA
- [qw/colA colB/] | ORDER BY colA, colB
- {-asc => 'colA'} | ORDER BY colA ASC
- {-desc => 'colB'} | ORDER BY colB DESC
- [ |
- {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
- {-desc => 'colB'} |
- ] |
- [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
- ==========================================================
+ |
+ \'colA DESC' | ORDER BY colA DESC
+ |
+ 'colA' | ORDER BY colA
+ |
+ [qw/colA colB/] | ORDER BY colA, colB
+ |
+ {-asc => 'colA'} | ORDER BY colA ASC
+ |
+ {-desc => 'colB'} | ORDER BY colB DESC
+ |
+ ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC
+ |
+ { -asc => [qw/colA colB] } | ORDER BY colA ASC, colB ASC
+ |
+ [ |
+ { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC,
+ { -desc => [qw/colB/], | colC ASC, colD ASC
+ { -asc => [qw/colC colD/],|
+ ] |
+ ===========================================================
Modified: SQL-Abstract/1.x/branches/and_or/t/04modifiers.t
===================================================================
--- SQL-Abstract/1.x/branches/and_or/t/04modifiers.t 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/t/04modifiers.t 2009-04-28 22:01:31 UTC (rev 6008)
@@ -338,8 +338,41 @@
},
);
-plan tests => @and_or_tests*3 + @numbered_mods*4;
+my @nest_tests = (
+ {
+ where => {a => 1, -nest => [b => 2, c => 3]},
+ stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )',
+ bind => [qw/2 3 1/],
+ },
+ {
+ where => {a => 1, -nest => {b => 2, c => 3}},
+ stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )',
+ bind => [qw/2 3 1/],
+ },
+ {
+ where => {a => 1, -or => {-nest => {b => 2, c => 3}}},
+ stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )',
+ bind => [qw/2 3 1/],
+ },
+ {
+ where => {a => 1, -or => {-nest => [b => 2, c => 3]}},
+ stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )',
+ bind => [qw/2 3 1/],
+ },
+ {
+ where => {a => 1, -nest => {-or => {b => 2, c => 3}}},
+ stmt => 'WHERE ( ( (c = ? OR b = ?) AND a = ? ) )',
+ bind => [qw/3 2 1/],
+ },
+ {
+ where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]],
+ stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )',
+ bind => [qw/1 2 3 4 5/],
+ },
+);
+plan tests => @and_or_tests*3 + @numbered_mods*4 + @nest_tests*2;
+
for my $case (@and_or_tests) {
TODO: {
local $TODO = $case->{todo} if $case->{todo};
@@ -364,8 +397,34 @@
}
}
+for my $case (@nest_tests) {
+ TODO: {
+ local $TODO = $case->{todo} if $case->{todo};
+
+ local $SQL::Abstract::Test::parenthesis_significant = 1;
+ local $Data::Dumper::Terse = 1;
+
+ my $sql = SQL::Abstract->new ($case->{args} || {});
+ lives_ok (sub {
+ my ($stmt, @bind) = $sql->where($case->{where});
+ is_same_sql_bind(
+ $stmt,
+ \@bind,
+ $case->{stmt},
+ $case->{bind},
+ )
+ || diag "Search term:\n" . Dumper $case->{where};
+ });
+ }
+}
+
+
+
my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E";
for my $case (@numbered_mods) {
+ TODO: {
+ local $TODO = $case->{todo} if $case->{todo};
+
local $Data::Dumper::Terse = 1;
my @w;
@@ -393,5 +452,6 @@
is (@non_match, 0, 'All warnings match the deprecation message')
|| diag join "\n", 'Rogue warnings:', @non_match;
+ }
}
Added: SQL-Abstract/1.x/branches/and_or/t/05between.t
===================================================================
--- SQL-Abstract/1.x/branches/and_or/t/05between.t (rev 0)
+++ SQL-Abstract/1.x/branches/and_or/t/05between.t 2009-04-28 22:01:31 UTC (rev 6008)
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use SQL::Abstract::Test import => ['is_same_sql_bind'];
+
+use Data::Dumper;
+use SQL::Abstract;
+
+=begin
+Test -between and -in
+ * between
+ * [scalar, scalar]
+ * [scalarref, scalar]
+ * [scalar, scalarref]
+ * [scalarref, scalarref]
+ * \[]
+ * \["? AND ?", scalar, scalar]
+ * \["1 AND ?", scalar]
+ * \["? AND 2", scalar]
+ * \["1 AND 2"]
+=cut
+
+my @in_between_tests = (
+ {
+ where => { x => { -between => [1, 2] } },
+ stmt => 'WHERE (x BETWEEN ? AND ?)',
+ bind => [qw/1 2/],
+ test => '-between with two placeholders',
+ },
+ {
+ where => { x => { -between => [\"1", 2] } },
+ stmt => 'WHERE (x BETWEEN 1 AND ?)',
+ bind => [qw/2/],
+ test => '-between with one literal sql arg and one placeholder',
+ },
+ {
+ where => { x => { -between => [1, \"2"] } },
+ stmt => 'WHERE (x BETWEEN ? AND 2)',
+ bind => [qw/1/],
+ test => '-between with one placeholder and one literal sql arg',
+ },
+ {
+ where => { x => { -between => [\'current_date - 1', \'current_date - 0'] } },
+ stmt => 'WHERE (x BETWEEN current_date - 1 AND current_date - 0)',
+ bind => [],
+ test => '-between with two literal sql arguments',
+ },
+ {
+ where => { x => { -between => \['? AND ?', 1, 2] } },
+ stmt => 'WHERE (x BETWEEN ? AND ?)',
+ bind => [1,2],
+ test => '-between with literal sql with placeholders (\["? AND ?", scalar, scalar])',
+ },
+ {
+ where => { x => { -between => \["'something' AND ?", 2] } },
+ stmt => "WHERE (x BETWEEN 'something' AND ?)",
+ bind => [2],
+ test => '-between with literal sql with one literal arg and one placeholder (\["\'something\' AND ?", scalar])',
+ },
+ {
+ where => { x => { -between => \["? AND 'something'", 1] } },
+ stmt => "WHERE (x BETWEEN ? AND 'something')",
+ bind => [1],
+ test => '-between with literal sql with one placeholder and one literal arg (\["? AND \'something\'", scalar])',
+ },
+ {
+ where => { x => { -between => \["'this' AND 'that'"] } },
+ stmt => "WHERE (x BETWEEN 'this' AND 'that')",
+ bind => [],
+ test => '-between with literal sql with two literal args (\["\'this\' AND \'that\'"])',
+ },
+);
+
+plan tests => @in_between_tests*3;
+
+for my $case (@in_between_tests) {
+ TODO: {
+ local $TODO = $case->{todo} if $case->{todo};
+
+ local $Data::Dumper::Terse = 1;
+
+ my @w;
+ local $SIG{__WARN__} = sub { push @w, @_ };
+ my $sql = SQL::Abstract->new ($case->{args} || {});
+ lives_ok (sub {
+ my ($stmt, @bind) = $sql->where($case->{where});
+ is_same_sql_bind(
+ $stmt,
+ \@bind,
+ $case->{stmt},
+ $case->{bind},
+ )
+ || diag "Search term:\n" . Dumper $case->{where};
+ });
+ is (@w, 0, $case->{test} || 'No warnings within in-between tests')
+ || diag join "\n", 'Emitted warnings:', @w;
+ }
+}
Modified: SQL-Abstract/1.x/branches/and_or/t/06order_by.t
===================================================================
--- SQL-Abstract/1.x/branches/and_or/t/06order_by.t 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/t/06order_by.t 2009-04-28 22:01:31 UTC (rev 6008)
@@ -3,6 +3,7 @@
use strict;
use warnings;
use Test::More;
+use Test::Exception;
use SQL::Abstract;
@@ -59,10 +60,36 @@
expects => '',
expects_quoted => '',
},
+
+ {
+ given => [{-desc => [ qw/colA colB/ ] }],
+ expects => ' ORDER BY colA DESC, colB DESC',
+ expects_quoted => ' ORDER BY `colA` DESC, `colB` DESC',
+ },
+ {
+ given => [{-desc => [ qw/colA colB/ ] }, {-asc => 'colC'}],
+ expects => ' ORDER BY colA DESC, colB DESC, colC ASC',
+ expects_quoted => ' ORDER BY `colA` DESC, `colB` DESC, `colC` ASC',
+ },
+ {
+ given => [{-desc => [ qw/colA colB/ ] }, {-asc => [ qw/colC colD/ ] }],
+ expects => ' ORDER BY colA DESC, colB DESC, colC ASC, colD ASC',
+ expects_quoted => ' ORDER BY `colA` DESC, `colB` DESC, `colC` ASC, `colD` ASC',
+ },
+ {
+ given => [{-desc => [ qw/colA colB/ ] }, {-desc => 'colC' }],
+ expects => ' ORDER BY colA DESC, colB DESC, colC DESC',
+ expects_quoted => ' ORDER BY `colA` DESC, `colB` DESC, `colC` DESC',
+ },
+ {
+ given => [{ -asc => 'colA' }, { -desc => [qw/colB/] }, { -asc => [qw/colC colD/] }],
+ expects => ' ORDER BY colA ASC, colB DESC, colC ASC, colD ASC',
+ expects_quoted => ' ORDER BY `colA` ASC, `colB` DESC, `colC` ASC, `colD` ASC',
+ },
);
-plan tests => (scalar(@cases) * 2);
+plan tests => (scalar(@cases) * 2) + 2;
my $sql = SQL::Abstract->new;
my $sqlq = SQL::Abstract->new({quote_char => '`'});
@@ -71,3 +98,15 @@
is($sql->_order_by($case->{given}), $case->{expects});
is($sqlq->_order_by($case->{given}), $case->{expects_quoted});
}
+
+throws_ok (
+ sub { $sql->_order_by({-desc => 'colA', -asc => 'colB' }) },
+ qr/hash passed .+ must have exactly one key/,
+ 'Undeterministic order exception',
+);
+
+throws_ok (
+ sub { $sql->_order_by({-desc => [ qw/colA colB/ ], -asc => [ qw/colC colD/ ] }) },
+ qr/hash passed .+ must have exactly one key/,
+ 'Undeterministic order exception',
+);
Modified: SQL-Abstract/1.x/branches/and_or/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/and_or/t/10test.t 2009-04-28 21:57:54 UTC (rev 6007)
+++ SQL-Abstract/1.x/branches/and_or/t/10test.t 2009-04-28 22:01:31 UTC (rev 6008)
@@ -6,7 +6,18 @@
use Test::More;
+# equivalent to $Module::Install::AUTHOR
+my $author = (
+ ( not -d './inc' )
+ or
+ ( -e ($^O eq 'VMS' ? './inc/_author' : './inc/.author') )
+);
+if (not $author and not $ENV{SQLATEST_TESTER} and not $ENV{AUTOMATED_TESTING}) {
+ plan skip_all => 'Skipping resource intensive self-tests, use SQLATEST_TESTER=1 to run';
+}
+
+
my @sql_tests = (
# WHERE condition - equal
{
@@ -101,6 +112,7 @@
equal => 1,
statements => [
q/SELECT foo FROM bar WHERE a = 1 AND b = 1 AND c = 1/,
+ q/SELECT foo FROM bar WHERE (a = 1 AND b = 1 AND c = 1)/,
q/SELECT foo FROM bar WHERE (a = 1 AND b = 1) AND c = 1/,
q/SELECT foo FROM bar WHERE a = 1 AND (b = 1 AND c = 1)/,
q/SELECT foo FROM bar WHERE ((((a = 1))) AND (b = 1 AND c = 1))/,
@@ -123,6 +135,36 @@
q/SELECT foo FROM bar WHERE ( ((a = 1) AND ( b = 1 OR (c = 1 OR d = 1) )) AND ((e = 1)) AND f = 1) /,
]
},
+ {
+ equal => 0,
+ parenthesis_significant => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE a = 1 AND b = 1 AND c = 1/,
+ q/SELECT foo FROM bar WHERE (a = 1 AND b = 1 AND c = 1)/,
+ q/SELECT foo FROM bar WHERE (a = 1 AND b = 1) AND c = 1/,
+ q/SELECT foo FROM bar WHERE a = 1 AND (b = 1 AND c = 1)/,
+ q/SELECT foo FROM bar WHERE ((((a = 1))) AND (b = 1 AND c = 1))/,
+ ]
+ },
+ {
+ equal => 0,
+ parenthesis_significant => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE a = 1 OR b = 1 OR c = 1/,
+ q/SELECT foo FROM bar WHERE (a = 1 OR b = 1) OR c = 1/,
+ q/SELECT foo FROM bar WHERE a = 1 OR (b = 1 OR c = 1)/,
+ q/SELECT foo FROM bar WHERE a = 1 OR ((b = 1 OR (c = 1)))/,
+ ]
+ },
+ {
+ equal => 0,
+ parenthesis_significant => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE (a = 1) AND (b = 1 OR c = 1 OR d = 1) AND (e = 1 AND f = 1)/,
+ q/SELECT foo FROM bar WHERE a = 1 AND (b = 1 OR c = 1 OR d = 1) AND e = 1 AND (f = 1)/,
+ q/SELECT foo FROM bar WHERE ( ((a = 1) AND ( b = 1 OR (c = 1 OR d = 1) )) AND ((e = 1)) AND f = 1) /,
+ ]
+ },
# WHERE condition - different
{
@@ -722,7 +764,12 @@
while (@$statements) {
my $sql1 = shift @$statements;
foreach my $sql2 (@$statements) {
+
+ no warnings qw/once/; # perl 5.10 is dumb
+ local $SQL::Abstract::Test::parenthesis_significant = $test->{parenthesis_significant}
+ if $test->{parenthesis_significant};
my $equal = eq_sql($sql1, $sql2);
+
TODO: {
local $TODO = $test->{todo} if $test->{todo};
More information about the Bast-commits
mailing list