Teach ::Tree that ILIKE (PostgreSQL) and REGEXP (MySQL) are binary ops
[dbsrgits/SQL-Abstract.git] / t / 14roundtrippin.t
CommitLineData
87abf9bc 1use warnings;
2use strict;
ea5d73f1 3
4use Test::More;
449e1320 5use Test::Exception;
6
2fadf08e 7use SQL::Abstract::Test import => [qw(is_same_sql dumper)];
ea5d73f1 8use SQL::Abstract::Tree;
9
10my $sqlat = SQL::Abstract::Tree->new;
11
12my @sql = (
efc991a0 13 "INSERT INTO artist DEFAULT VALUES",
14 "INSERT INTO artist VALUES ()",
87abf9bc 15 "SELECT a, b, c FROM foo WHERE foo.a = 1 and foo.b LIKE 'station'",
c4d7cfcf 16 "SELECT COUNT( * ) FROM foo",
87abf9bc 17 "SELECT COUNT( * ), SUM( blah ) FROM foo",
c4d7cfcf 18 "SELECT * FROM (SELECT * FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'",
87abf9bc 19 "SELECT * FROM lolz WHERE ( foo.a = 1 ) and foo.b LIKE 'station'",
efc991a0 20 "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]",
af75bd59 21 "SELECT * FROM foo WHERE NOT EXISTS (SELECT bar FROM baz)",
b6c0db74 22 "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'",
1f00df9f 23 "SELECT * FROM (SELECT SUM (CASE WHEN GETUTCDATE() > DATEADD(second, 4 * 60, last_checkin) THEN 1 ELSE 0 END) FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'",
b6c0db74 24 "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 ) ) ) )",
1ec9b9e3 25 "SELECT foo AS bar FROM baz ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC",
a710744f 26 "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",
8bbeb3e2 27 "SELECT * FROM foo WHERE foo.a @@ to_tsquery('word')",
b4085a1a 28 "SELECT * FROM foo ORDER BY name + ?, [me].[id]",
de580bbd 29 "SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g",
0ec2e265 30 "SELECT [me].[id], ROW_NUMBER() OVER (ORDER BY (SELECT 1)) AS [rno__row__index] FROM ( SELECT [me].[id] FROM [LogParents] [me]) [me]",
08e16360 31 # deliberate batshit insanity
32 "SELECT foo FROM bar WHERE > 12",
bf782d2e 33 'SELECT ilike_any_or FROM bar WHERE ( baz ILIKE ANY(?) OR bat ILIKE ANY(?) )',
34 'SELECT regexp_or FROM bar WHERE ( baz REGEXP ? OR bat REGEXP ? )',
ea5d73f1 35);
36
87abf9bc 37# FIXME FIXME FIXME
38# The formatter/unparser accumulated a ton of technical debt,
39# and I don't have time to fix it all :( Some of the problems:
40# - format() does an implicit parenthesis unroll for prettyness
41# which makes it hard to do exact comparisons
42# - there is no space preservation framework (also makes comparisons
43# problematic)
44# - there is no operator case preservation framework either
45#
46# So what we do instead is resort to some monkey patching and
47# lowercasing and stuff to get something we can compare to the
48# original SQL string
49# Ugly but somewhat effective
50
51for my $orig (@sql) {
52 my $plain_formatted = $sqlat->format($orig);
53 is_same_sql( $plain_formatted, $orig, 'Formatted string is_same_sql()-matched' );
54
55 my $ast = $sqlat->parse($orig);
56 my $reassembled = do {
57 no warnings 'redefine';
58 local *SQL::Abstract::Tree::_parenthesis_unroll = sub {};
59 $sqlat->unparse($ast);
60 };
ea5d73f1 61
7d273452 62 # deal with whitespace around parenthesis readjustment
63 $_ =~ s/ \s* ( [ \(\) ] ) \s* /$1/gx
87abf9bc 64 for ($orig, $reassembled);
65
b4085a1a 66 is (
67 lc($reassembled),
68 lc($orig),
69 sprintf( 'roundtrip works (%s...)', substr $orig, 0, 20 )
70 ) or do {
2fadf08e 71 my ($ast1, $ast2) = map { dumper( $sqlat->parse($_) ) } ( $orig, $reassembled );
b4085a1a 72
73 note "ast1: $ast1";
74 note "ast2: $ast2";
75 };
87abf9bc 76}
ea5d73f1 77
7d273452 78# this is invalid SQL, we are just checking that the parser
79# does not inadvertently make it right
80my $sql = 'SELECT * FROM foo WHERE x IN ( ( 1 ) )';
81is(
82 $sqlat->unparse($sqlat->parse($sql)),
83 $sql,
84 'Multi-parens around IN survive',
85);
86
449e1320 87lives_ok { $sqlat->unparse( $sqlat->parse( <<'EOS' ) ) } 'Able to parse/unparse grossly malformed sql';
88SELECT
89 (
90 SELECT *, * FROM EXISTS bar JOIN ON a = b
91 NOT WHERE c !!= d
92 ),
93 NOT x,
94 (
95 SELECT * FROM bar WHERE NOT NOT EXISTS (SELECT 1)
96 ),
97WHERE NOT NOT 1 AND OR foo IN (1,2,,,3,,,),
98GROUP BY bar
99
100EOS
101
ea5d73f1 102done_testing;