Hello community,
here is the log from the commit of package perl-SQL-Abstract for openSUSE:Factory checked in at 2013-07-30 14:04:22
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-SQL-Abstract (Old)
and /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-SQL-Abstract"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-SQL-Abstract/perl-SQL-Abstract.changes 2013-06-06 13:27:46.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new/perl-SQL-Abstract.changes 2013-07-30 14:04:23.000000000 +0200
@@ -1,0 +2,9 @@
+Sat Jul 27 11:58:57 UTC 2013 - coolo@suse.com
+
+- updated to 1.74
+ - Fix insufficient parenthesis unroll during operator comparison
+ - 'ORDER BY foo' and 'ORDER BY foo ASC' are now considered equal
+ by default (with a switch to reenable old behavior when necessary)
+ - Change parser to not eagerly slurp RHS expressions it doesn't recognize
+
+-------------------------------------------------------------------
Old:
----
SQL-Abstract-1.73.tar.gz
New:
----
SQL-Abstract-1.74.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-SQL-Abstract.spec ++++++
--- /var/tmp/diff_new_pack.0HRWR5/_old 2013-07-30 14:04:24.000000000 +0200
+++ /var/tmp/diff_new_pack.0HRWR5/_new 2013-07-30 14:04:24.000000000 +0200
@@ -17,14 +17,14 @@
Name: perl-SQL-Abstract
-Version: 1.73
+Version: 1.74
Release: 0
%define cpan_name SQL-Abstract
Summary: Generate SQL from Perl data structures
License: Artistic-1.0 or GPL-1.0+
Group: Development/Libraries/Perl
Url: http://search.cpan.org/dist/SQL-Abstract/
-Source: http://www.cpan.org/authors/id/F/FR/FREW/%{cpan_name}-%{version}.tar.gz
+Source: http://www.cpan.org/authors/id/R/RI/RIBASUSHI/%{cpan_name}-%{version}.tar.gz
BuildArch: noarch
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
@@ -32,6 +32,7 @@
BuildRequires: perl(Class::Accessor::Grouped) >= 0.10005
BuildRequires: perl(Getopt::Long::Descriptive) >= 0.091
BuildRequires: perl(Hash::Merge) >= 0.12
+BuildRequires: perl(Test::Deep) >= 0.101
BuildRequires: perl(Test::Exception)
BuildRequires: perl(Test::More) >= 0.92
BuildRequires: perl(Test::Warn)
++++++ SQL-Abstract-1.73.tar.gz -> SQL-Abstract-1.74.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/Changes new/SQL-Abstract-1.74/Changes
--- old/SQL-Abstract-1.73/Changes 2012-07-10 23:19:39.000000000 +0200
+++ new/SQL-Abstract-1.74/Changes 2013-06-05 15:25:39.000000000 +0200
@@ -1,5 +1,12 @@
Revision history for SQL::Abstract
+revision 1.74 2013-06-04
+----------------------------
+ - Fix insufficient parenthesis unroll during operator comparison
+ - 'ORDER BY foo' and 'ORDER BY foo ASC' are now considered equal
+ by default (with a switch to reenable old behavior when necessary)
+ - Change parser to not eagerly slurp RHS expressions it doesn't recognize
+
revision 1.73 2012-07-10
----------------------------
- Fix parsing of ORDER BY foo + ?
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/MANIFEST new/SQL-Abstract-1.74/MANIFEST
--- old/SQL-Abstract-1.73/MANIFEST 2012-07-10 23:22:19.000000000 +0200
+++ new/SQL-Abstract-1.74/MANIFEST 2013-06-05 15:25:54.000000000 +0200
@@ -42,7 +42,6 @@
t/20injection_guard.t
t/21op_ident.t
t/22op_value.t
-t/23reassembly-bugs.t
t/90pod.t
t/91podcoverage.t
t/dbic/bulk-insert.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/META.yml new/SQL-Abstract-1.74/META.yml
--- old/SQL-Abstract-1.73/META.yml 2012-07-10 23:22:17.000000000 +0200
+++ new/SQL-Abstract-1.74/META.yml 2013-06-05 15:25:52.000000000 +0200
@@ -5,13 +5,14 @@
build_requires:
ExtUtils::MakeMaker: 6.59
Storable: 0
+ Test::Deep: 0.101
Test::Exception: 0
Test::More: 0.92
Test::Warn: 0
configure_requires:
ExtUtils::MakeMaker: 6.59
distribution_type: module
-dynamic_config: 1
+dynamic_config: 0
generated_by: 'Module::Install version 1.06'
license: perl
meta-spec:
@@ -36,4 +37,4 @@
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Abstract
license: http://dev.perl.org/licenses/
repository: git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git
-version: 1.73
+version: 1.74
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/Makefile.PL new/SQL-Abstract-1.74/Makefile.PL
--- old/SQL-Abstract-1.73/Makefile.PL 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/Makefile.PL 2013-06-05 15:25:39.000000000 +0200
@@ -13,6 +13,8 @@
all_from 'lib/SQL/Abstract.pm';
+dynamic_config 0;
+
requires 'List::Util' => 0;
requires 'Scalar::Util' => 0;
requires 'Class::Accessor::Grouped' => 0.10005;
@@ -22,6 +24,7 @@
test_requires "Test::More" => 0.92;
test_requires "Test::Exception" => 0;
test_requires "Test::Warn" => 0;
+test_requires "Test::Deep" => '0.101';
test_requires "Storable" => 0; # for cloning in tests
no_index package => 'DBIx::Class::Storage::Debug::PrettyPrint';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract/Test.pm new/SQL-Abstract-1.74/lib/SQL/Abstract/Test.pm
--- old/SQL-Abstract-1.73/lib/SQL/Abstract/Test.pm 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/lib/SQL/Abstract/Test.pm 2013-06-05 15:25:39.000000000 +0200
@@ -5,6 +5,7 @@
use base qw/Test::Builder::Module Exporter/;
use Data::Dumper;
use Test::Builder;
+use Test::Deep ();
use SQL::Abstract::Tree;
our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
@@ -15,6 +16,8 @@
our $case_sensitive = 0;
our $parenthesis_significant = 0;
+our $order_by_asc_significant = 0;
+
our $sql_differ; # keeps track of differing portion between SQLs
our $tb = __PACKAGE__->builder;
@@ -102,14 +105,7 @@
}
-sub eq_bind {
- my ($bind_ref1, $bind_ref2) = @_;
-
- local $Data::Dumper::Useqq = 1;
- local $Data::Dumper::Sortkeys = 1;
-
- return Dumper($bind_ref1) eq Dumper($bind_ref2);
-}
+sub eq_bind { goto &Test::Deep::eq_deeply };
sub eq_sql {
my ($sql1, $sql2) = @_;
@@ -179,6 +175,11 @@
$sqlat->_parenthesis_unroll($_) for $left, $right;
}
+ # unroll ASC order by's
+ unless ($order_by_asc_significant) {
+ $sqlat->_strip_asc_from_order_by($_) for $left, $right;
+ }
+
if ( $left->[0] ne $right->[0] ) {
$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
$sqlat->unparse($left),
@@ -332,6 +333,11 @@
parenthesis. Useful while testing C vs C.
Defaults to false;
+=head2 $order_by_asc_significant
+
+If true SQL comparison will consider C<ORDER BY foo ASC> and
+C<ORDER BY foo> to be different. Default is false;
+
=head2 $sql_differ
When L returns false, the global variable
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract/Tree.pm new/SQL-Abstract-1.74/lib/SQL/Abstract/Tree.pm
--- old/SQL-Abstract-1.73/lib/SQL/Abstract/Tree.pm 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/lib/SQL/Abstract/Tree.pm 2013-06-05 15:25:39.000000000 +0200
@@ -97,19 +97,19 @@
# * AS is not really an operator but is handled here as it's also LHS/RHS
# this will be included in the $binary_op_re, the distinction is interesting during
-# testing as one is tighter than the other, plus mathops have different look
-# ahead/behind (e.g. "x"="y" )
-my @math_op_keywords = (qw/ - + < > != <> = <= >= /);
-my $math_op_re = join ("\n\t|\n", map
+# testing as one is tighter than the other, plus alphanum cmp ops have different
+# look ahead/behind (e.g. "x"="y" )
+my @alphanum_cmp_op_keywords = (qw/< > != <> = <= >= /);
+my $alphanum_cmp_op_re = join ("\n\t|\n", map
{ "(?: (?<= [\\w\\s] | $quote_right ) | \\A )" . quotemeta ($_) . "(?: (?= [\\w\\s] | $quote_left ) | \\z )" }
- @math_op_keywords
+ @alphanum_cmp_op_keywords
);
-$math_op_re = qr/$math_op_re/x;
+$alphanum_cmp_op_re = qr/$alphanum_cmp_op_re/x;
my $binary_op_re = '(?: NOT \s+)? (?:' . join ('|', qw/IN BETWEEN R?LIKE/) . ')';
$binary_op_re = join "\n\t|\n",
"$op_look_behind (?i: $binary_op_re | AS ) $op_look_ahead",
- $math_op_re,
+ $alphanum_cmp_op_re,
$op_look_behind . 'IS (?:\s+ NOT)?' . "(?= \\s+ NULL \\b | $op_look_ahead )",
;
$binary_op_re = qr/$binary_op_re/x;
@@ -129,7 +129,7 @@
$unary_op_re,
$asc_desc_re,
$and_or_re,
- "$op_look_behind \\* $op_look_ahead",
+ $op_look_behind . ' \* ' . $op_look_ahead,
(map { quotemeta $_ } qw/, ( )/),
$placeholder_re,
);
@@ -149,8 +149,7 @@
my $expr_term_re = qr/$expr_start_re | \)/x;
my $rhs_term_re = qr/ $expr_term_re | $binary_op_re | $unary_op_re | $asc_desc_re | $and_or_re | \, /x;
-my $common_single_args_re = qr/ \* | $placeholder_re /x;
-my $all_std_keywords_re = qr/ $rhs_term_re | \( | $common_single_args_re /x;
+my $all_std_keywords_re = qr/ $rhs_term_re | \( | $placeholder_re /x;
# anchor everything - even though keywords are separated by the tokenizer, leakage may occur
for (
@@ -158,14 +157,13 @@
$quote_right,
$placeholder_re,
$expr_start_re,
- $math_op_re,
+ $alphanum_cmp_op_re,
$binary_op_re,
$unary_op_re,
$asc_desc_re,
$and_or_re,
$expr_term_re,
$rhs_term_re,
- $common_single_args_re,
$all_std_keywords_re,
) {
$_ = qr/ \A $_ \z /x;
@@ -444,18 +442,28 @@
}
# check if the current token is an unknown op-start
- elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $common_single_args_re ) ) {
+ elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $placeholder_re ) ) {
push @left, [ $token => [ $self->_recurse_parse($tokens, PARSE_RHS) ] ];
}
# we're now in "unknown token" land - start eating tokens until
- # we see something familiar
+ # we see something familiar, OR in the case of RHS (binop) stop
+ # after the first token
+ # Also stop processing when we could end up with an unknown func
else {
my @lits = [ -LITERAL => [$token] ];
- while (@$tokens and $tokens->[0] !~ $all_std_keywords_re) {
- push @lits, [ -LITERAL => [ shift @$tokens ] ];
- }
+ unless ( $state == PARSE_RHS ) {
+ while (
+ @$tokens
+ and
+ $tokens->[0] !~ $all_std_keywords_re
+ and
+ ! ( @$tokens > 1 and $tokens->[1] eq '(' )
+ ) {
+ push @lits, [ -LITERAL => [ shift @$tokens ] ];
+ }
+ }
if (@left == 1) {
unshift @lits, pop @left;
@@ -466,21 +474,14 @@
push @left, @lits;
}
- # deal with post-fix operators (only when sql is sane - i.e. we have one element to apply to)
- if (@left == 1 and @$tokens) {
+ if (@$tokens) {
- # asc/desc
+ # deal with post-fix operators (asc/desc)
if ($tokens->[0] =~ $asc_desc_re) {
- my $op = shift @$tokens;
-
- # if -MISC - this is a literal collection, do not promote asc/desc to an op
- if ($left[0][0] eq '-MISC') {
- push @{$left[0][1]}, [ -LITERAL => [ $op ] ];
- }
- else {
- @left = [ ('-' . uc ($op)) => [ @left ] ];
- }
+ @left = [ ('-' . uc (shift @$tokens)) => [ @left ] ];
}
+
+ return @left if $state == PARSE_RHS and $left[-1][0] eq '-LITERAL';
}
}
}
@@ -596,14 +597,17 @@
}
else {
my ($l, $r) = @{$self->pad_keyword($op, $depth)};
- return sprintf "$l%s%s%s$r",
- $self->format_keyword($op),
+
+ my $rhs = $self->_unparse($args, $bindargs, $depth);
+
+ return sprintf "$l%s$r", join(
( ref $args eq 'ARRAY' and @{$args} == 1 and $args->[0][0] eq '-PAREN' )
? '' # mysql--
: ' '
,
- $self->_unparse($args, $bindargs, $depth),
- ;
+ $self->format_keyword($op),
+ (length $rhs ? $rhs : () ),
+ );
}
}
@@ -695,9 +699,9 @@
@{$child->[1][0][1]} == 2
and
! (
- $child->[1][0][0] =~ $math_op_re
+ $child->[1][0][0] =~ $alphanum_cmp_op_re
and
- $ast->[0] =~ $math_op_re
+ $ast->[0] =~ $alphanum_cmp_op_re
)
) {
push @children, @{$child->[1]};
@@ -715,9 +719,9 @@
and
@{$child->[1][0][1]} == 1
and
- $ast->[0] =~ $math_op_re
+ $ast->[0] =~ $alphanum_cmp_op_re
and
- $child->[1][0][0] !~ $math_op_re
+ $child->[1][0][0] !~ $alphanum_cmp_op_re
and
(
$child->[1][0][1][0][0] eq '-PAREN'
@@ -731,6 +735,23 @@
$changes++;
}
+ # a construct of ... ( somefunc ( ... ) ) ... can safely lose the outer parens
+ # except for the case of ( NOT ( ... ) ) which has already been handled earlier
+ elsif (
+ @{$child->[1]} == 1
+ and
+ @{$child->[1][0][1]} == 1
+ and
+ $child->[1][0][0] ne 'NOT'
+ and
+ ref $child->[1][0][1][0] eq 'ARRAY'
+ and
+ $child->[1][0][1][0][0] eq '-PAREN'
+ ) {
+ push @children, @{$child->[1]};
+ $changes++;
+ }
+
# otherwise no more mucking for this pass
else {
@@ -743,6 +764,30 @@
} while ($changes);
}
+sub _strip_asc_from_order_by {
+ my ($self, $ast) = @_;
+
+ return $ast if (
+ ref $ast ne 'ARRAY'
+ or
+ $ast->[0] ne 'ORDER BY'
+ );
+
+
+ my $to_replace;
+
+ if (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-ASC') {
+ $to_replace = [ $ast->[1][0] ];
+ }
+ elsif (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-LIST') {
+ $to_replace = [ grep { $_->[0] eq '-ASC' } @{$ast->[1][0][1]} ];
+ }
+
+ @$_ = @{$_->[1][0]} for @$to_replace;
+
+ $ast;
+}
+
sub format { my $self = shift; $self->unparse($self->parse($_[0]), $_[1]) }
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract.pm new/SQL-Abstract-1.74/lib/SQL/Abstract.pm
--- old/SQL-Abstract-1.73/lib/SQL/Abstract.pm 2012-07-10 23:19:51.000000000 +0200
+++ new/SQL-Abstract-1.74/lib/SQL/Abstract.pm 2013-06-05 15:25:39.000000000 +0200
@@ -15,7 +15,7 @@
# GLOBALS
#======================================================================
-our $VERSION = '1.73';
+our $VERSION = '1.74';
# This would confuse some packagers
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
@@ -1510,7 +1510,7 @@
my $sql = SQL::Abstract->new;
- my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
+ my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order);
my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
@@ -1938,8 +1938,8 @@
The argument can be either an arrayref (interpreted as a list
of field names, will be joined by commas and quoted), or a
plain scalar (literal SQL, not quoted).
-Please observe that this API is not as flexible as for
-the first argument C<$table>, for backwards compatibility reasons.
+Please observe that this API is not as flexible as that of
+the first argument C<$source>, for backwards compatibility reasons.
=item $where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/04modifiers.t new/SQL-Abstract-1.74/t/04modifiers.t
--- old/SQL-Abstract-1.73/t/04modifiers.t 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/t/04modifiers.t 2013-06-05 15:25:39.000000000 +0200
@@ -7,9 +7,10 @@
use SQL::Abstract::Test import => ['is_same_sql_bind'];
use Data::Dumper;
-use Storable qw/dclone/;
use SQL::Abstract;
+my $dclone = eval { require Storable; \&Storable::dclone };
+
#### WARNING ####
#
# -nest has been undocumented on purpose, but is still supported for the
@@ -380,8 +381,6 @@
},
);
-plan tests => @and_or_tests*4 + @numbered_mods*4 + @nest_tests*2;
-
for my $case (@and_or_tests) {
TODO: {
local $TODO = $case->{todo} if $case->{todo};
@@ -392,7 +391,9 @@
local $SIG{__WARN__} = sub { push @w, @_ };
my $sql = SQL::Abstract->new ($case->{args} || {});
- my $where_copy = dclone($case->{where});
+
+ my $where_copy = $dclone->($case->{where})
+ if $dclone;;
lives_ok (sub {
my ($stmt, @bind) = $sql->where($case->{where});
@@ -407,7 +408,8 @@
is (@w, 0, 'No warnings within and-or tests')
|| diag join "\n", 'Emitted warnings:', @w;
- is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged');
+ is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged')
+ if $dclone;
}
}
@@ -469,3 +471,4 @@
}
}
+done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/10test.t new/SQL-Abstract-1.74/t/10test.t
--- old/SQL-Abstract-1.73/t/10test.t 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/t/10test.t 2013-06-05 15:25:39.000000000 +0200
@@ -153,7 +153,7 @@
},
{
equal => 0,
- parenthesis_significant => 1,
+ opts => { 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)/,
@@ -164,7 +164,7 @@
},
{
equal => 0,
- parenthesis_significant => 1,
+ opts => { 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/,
@@ -174,7 +174,7 @@
},
{
equal => 0,
- parenthesis_significant => 1,
+ opts => { 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)/,
@@ -260,7 +260,7 @@
},
{
equal => 0,
- parenthesis_significant => 1,
+ opts => { parenthesis_significant => 1 },
statements => [
q/SELECT foo FROM bar WHERE a IN (1,2,3)/,
q/SELECT foo FROM bar WHERE a IN (1,3,2)/,
@@ -592,6 +592,34 @@
]
},
+ # order by
+ {
+ equal => 1,
+ statements => [
+ q/SELECT * FROM foo ORDER BY bar/,
+ q/SELECT * FROM foo ORDER BY bar ASC/,
+ q/SELECT * FROM foo ORDER BY bar asc/,
+ ],
+ },
+ {
+ equal => 1,
+ statements => [
+ q/SELECT * FROM foo ORDER BY bar, baz ASC/,
+ q/SELECT * FROM foo ORDER BY bar ASC, baz/,
+ q/SELECT * FROM foo ORDER BY bar asc, baz ASC/,
+ q/SELECT * FROM foo ORDER BY bar, baz/,
+ ],
+ },
+ {
+ equal => 0,
+ opts => { order_by_asc_significant => 1 },
+ statements => [
+ q/SELECT * FROM foo ORDER BY bar/,
+ q/SELECT * FROM foo ORDER BY bar ASC/,
+ q/SELECT * FROM foo ORDER BY bar desc/,
+ ],
+ },
+
# list permutations
{
equal => 0,
@@ -711,7 +739,26 @@
'WHERE ( foo GLOB ? )',
'WHERE foo GLOB ?',
],
- }
+ },
+ {
+ equal => 1,
+ statements => [
+ 'SELECT FIRST ? SKIP ? [me].[id], [me].[owner]
+ FROM [books] [me]
+ WHERE ( ( (EXISTS (
+ SELECT FIRST ? SKIP ? [owner].[id]
+ FROM [owners] [owner]
+ WHERE ( [books].[owner] = [owner].[id] )
+ )) AND [source] = ? ) )',
+ 'SELECT FIRST ? SKIP ? [me].[id], [me].[owner]
+ FROM [books] [me]
+ WHERE ( ( EXISTS (
+ SELECT FIRST ? SKIP ? [owner].[id]
+ FROM [owners] [owner]
+ WHERE ( [books].[owner] = [owner].[id] )
+ ) AND [source] = ? ) )',
+ ],
+ },
);
my @bind_tests = (
@@ -924,14 +971,23 @@
)]);
for my $test (@sql_tests) {
+
+ # this does not work on 5.8.8 and earlier :(
+ #local @{*SQL::Abstract::Test::}{keys %{$test->{opts}}} = map { \$_ } values %{$test->{opts}}
+ # if $test->{opts};
+
+ my %restore_globals;
+
+ for (keys %{$test->{opts} || {} }) {
+ $restore_globals{$_} = ${${*SQL::Abstract::Test::}{$_}};
+ ${*SQL::Abstract::Test::}{$_} = \ do { my $cp = $test->{opts}{$_} };
+ }
+
my $statements = $test->{statements};
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: {
@@ -956,6 +1012,9 @@
}
}
}
+
+ ${*SQL::Abstract::Test::}{$_} = \$restore_globals{$_}
+ for keys %restore_globals;
}
for my $test (@bind_tests) {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/11parser.t new/SQL-Abstract-1.74/t/11parser.t
--- old/SQL-Abstract-1.73/t/11parser.t 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/t/11parser.t 2013-06-05 15:25:39.000000000 +0200
@@ -619,18 +619,211 @@
]
], 'Lists parsed correctly');
-is_deeply($sqlat->parse("SELECT * * FROM (SELECT *, FROM foobar baz buzz) foo bar WHERE NOT NOT NOT EXISTS (SELECT 'cr,ap') AND foo.a = ? and not (foo.b LIKE 'station') and x = y and a = b and GROUP BY , ORDER BY x x1 x2 y asc, max(y) desc x z desc"), [
+is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC'), [
[
"SELECT",
[
[
- "*",
+ "-LITERAL",
+ [
+ "foo"
+ ]
+ ]
+ ]
+ ],
+ [
+ "FROM",
+ [
+ [
+ "-LITERAL",
+ [
+ "bar"
+ ]
+ ]
+ ]
+ ],
+ [
+ "ORDER BY",
+ [
+ [
+ "-LIST",
+ [
+ [
+ "-DESC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-LITERAL",
+ [
+ "x"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "+"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-PLACEHOLDER",
+ [
+ "?"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "oomph"
+ ]
+ ],
+ [
+ "-DESC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-LITERAL",
+ [
+ "y"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "-"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-PLACEHOLDER",
+ [
+ "?"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "unf"
+ ]
+ ],
+ [
+ "-ASC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-LITERAL",
+ [
+ "baz.g"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "/"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-PLACEHOLDER",
+ [
+ "?"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-DESC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-LITERAL",
+ [
+ "buzz"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "*"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ 0
+ ]
+ ]
+ ]
+ ]
+ ]
+ ],
+ [
+ "-DESC",
+ [
+ [
+ "-LITERAL",
+ [
+ "foo"
+ ]
+ ]
+ ]
+ ],
+ [
+ "-ASC",
+ [
+ [
+ "-LITERAL",
+ [
+ "ickk"
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+], 'Crazy ORDER BY parsed correctly');
+
+is_deeply( $sqlat->parse("META SELECT * * FROM (SELECT *, FROM foobar baz buzz) foo bar WHERE NOT NOT NOT EXISTS (SELECT 'cr,ap') AND foo.a = ? STUFF moar(stuff) and not (foo.b LIKE 'station') and x = y and a = b and GROUP BY , ORDER BY x x1 x2 y asc, max(y) desc x z desc"), [
+ [
+ "-LITERAL",
+ [
+ "META"
+ ]
+ ],
+ [
+ "SELECT",
+ [
+ [
+ "-MISC",
[
[
"-LITERAL",
[
"*"
]
+ ],
+ [
+ "-LITERAL",
+ [
+ "*"
+ ]
]
]
]
@@ -764,9 +957,36 @@
]
],
[
- "-PLACEHOLDER",
+ "-MISC",
[
- "?"
+ [
+ "-PLACEHOLDER",
+ [
+ "?"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "STUFF"
+ ]
+ ]
+ ],
+ ],
+ [
+ 'moar',
+ [
+ [
+ '-PAREN',
+ [
+ [
+ '-LITERAL',
+ [
+ 'stuff'
+ ]
+ ]
+ ]
+ ]
]
]
]
@@ -855,78 +1075,81 @@
"-LIST",
[
[
- "-MISC",
- [
- [
- "-LITERAL",
- [
- "x"
- ]
- ],
- [
- "-LITERAL",
- [
- "x1"
- ]
- ],
- [
- "-LITERAL",
- [
- "x2"
- ]
- ],
- [
- "-LITERAL",
- [
- "y"
- ]
- ],
- [
- "-LITERAL",
- [
- "asc"
- ]
- ]
- ]
- ],
- [
- "max",
+ "-ASC",
[
[
"-MISC",
[
[
- "-DESC",
+ "-LITERAL",
[
- [
- "-PAREN",
- [
- [
- "-LITERAL",
- [
- "y"
- ]
- ]
- ]
- ]
+ "x"
]
],
[
"-LITERAL",
[
- "x"
+ "x1"
]
],
[
"-LITERAL",
[
- "z"
+ "x2"
]
],
[
"-LITERAL",
[
- "desc"
+ "y"
+ ]
+ ]
+ ]
+ ],
+ ],
+ ],
+ [
+ "max",
+ [
+ [
+ "-DESC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-MISC",
+ [
+ [
+ "-DESC",
+ [
+ [
+ "-PAREN",
+ [
+ [
+ "-LITERAL",
+ [
+ "y"
+ ]
+ ]
+ ]
+ ]
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "x"
+ ]
+ ],
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "z"
+ ]
+ ]
]
]
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/14roundtrippin.t new/SQL-Abstract-1.74/t/14roundtrippin.t
--- old/SQL-Abstract-1.73/t/14roundtrippin.t 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/t/14roundtrippin.t 2013-06-05 15:25:39.000000000 +0200
@@ -1,4 +1,5 @@
-#!/usr/bin/env perl
+use warnings;
+use strict;
use Test::More;
use Test::Exception;
@@ -11,25 +12,51 @@
my @sql = (
"INSERT INTO artist DEFAULT VALUES",
"INSERT INTO artist VALUES ()",
- "SELECT a, b, c FROM foo WHERE foo.a =1 and foo.b LIKE 'station'",
+ "SELECT a, b, c FROM foo WHERE foo.a = 1 and foo.b LIKE 'station'",
"SELECT COUNT( * ) FROM foo",
+ "SELECT COUNT( * ), SUM( blah ) FROM foo",
"SELECT * FROM (SELECT * FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'",
- "SELECT * FROM lolz WHERE ( foo.a =1 ) and foo.b LIKE 'station'",
+ "SELECT * FROM lolz WHERE ( foo.a = 1 ) and foo.b LIKE 'station'",
"SELECT [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype] FROM [users_roles] [me] JOIN [roles] [role] ON [role].[id] = [me].[role_id] JOIN [roles_permissions] [role_permissions] ON [role_permissions].[role_id] = [role].[id] JOIN [permissions] [permission] ON [permission].[id] = [role_permissions].[permission_id] JOIN [permissionscreens] [permission_screens] ON [permission_screens].[permission_id] = [permission].[id] JOIN [screens] [screen] ON [screen].[id] = [permission_screens].[screen_id] WHERE ( [me].[user_id] = ? ) GROUP BY [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype]",
"SELECT * FROM foo WHERE NOT EXISTS (SELECT bar FROM baz)",
"SELECT * FROM (SELECT SUM (CASE WHEN me.artist = 'foo' THEN 1 ELSE 0 END AS artist_sum) FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'",
"SELECT COUNT( * ) FROM foo me JOIN bar rel_bar ON rel_bar.id_bar = me.fk_bar WHERE NOT EXISTS (SELECT inner_baz.id_baz FROM baz inner_baz WHERE ( ( inner_baz.fk_a != ? AND ( fk_bar = me.fk_bar AND name = me.name ) ) ) )",
+ "SELECT foo AS bar FROM baz ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC",
+ "SELECT inner_forum_roles.forum_id FROM forum_roles AS inner_forum_roles LEFT JOIN user_roles AS inner_user_roles USING(user_role_type_id) WHERE inner_user_roles.user_id = users__row.user_id",
+ "SELECT * FROM foo WHERE foo.a @@ to_tsquery('word')",
);
-for (@sql) {
- # Needs whitespace preservation in the AST to work, pending
- #local $SQL::Abstract::Test::mysql_functions = 1;
- is_same_sql ($sqlat->format($_), $_, sprintf 'roundtrip works (%s...)', substr $_, 0, 20);
-}
+# FIXME FIXME FIXME
+# The formatter/unparser accumulated a ton of technical debt,
+# and I don't have time to fix it all :( Some of the problems:
+# - format() does an implicit parenthesis unroll for prettyness
+# which makes it hard to do exact comparisons
+# - there is no space preservation framework (also makes comparisons
+# problematic)
+# - there is no operator case preservation framework either
+#
+# So what we do instead is resort to some monkey patching and
+# lowercasing and stuff to get something we can compare to the
+# original SQL string
+# Ugly but somewhat effective
+
+for my $orig (@sql) {
+ my $plain_formatted = $sqlat->format($orig);
+ is_same_sql( $plain_formatted, $orig, 'Formatted string is_same_sql()-matched' );
+
+ my $ast = $sqlat->parse($orig);
+ my $reassembled = do {
+ no warnings 'redefine';
+ local *SQL::Abstract::Tree::_parenthesis_unroll = sub {};
+ $sqlat->unparse($ast);
+ };
+
+ # deal with parenthesis readjustment
+ $_ =~ s/\s*([\(\)])\s*/$1 /g
+ for ($orig, $reassembled);
-# delete this test when mysql_functions gets implemented
-my $sql = 'SELECT COUNT( * ), SUM( blah ) FROM foo';
-is($sqlat->format($sql), $sql, 'Roundtripping to mysql-compatible paren. syntax');
+ is (lc($reassembled), lc($orig), sprintf 'roundtrip works (%s...)', substr $orig, 0, 20);
+}
lives_ok { $sqlat->unparse( $sqlat->parse( <<'EOS' ) ) } 'Able to parse/unparse grossly malformed sql';
SELECT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/23reassembly-bugs.t new/SQL-Abstract-1.74/t/23reassembly-bugs.t
--- old/SQL-Abstract-1.73/t/23reassembly-bugs.t 2012-06-15 03:07:59.000000000 +0200
+++ new/SQL-Abstract-1.74/t/23reassembly-bugs.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,15 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use SQL::Abstract::Tree;
-
-my $sqlat = SQL::Abstract::Tree->new({});
-
-is(
- $sqlat->format('SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g'),
- 'SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g',
- 'complex order by correctly reassembled'
-);
-
-done_testing;
--
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org