Fix stupid not exists omission
[scpubgit/Q-Branch.git] / t / 07subqueries.t
CommitLineData
4f30591b 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use Test::More;
6
7use SQL::Abstract::Test import => ['is_same_sql_bind'];
8
9use SQL::Abstract;
10
48d9f5f8 11#### WARNING ####
12#
13# -nest has been undocumented on purpose, but is still supported for the
14# foreseable future. Do not rip out the -nest tests before speaking to
15# someone on the DBIC mailing list or in irc.perl.org#dbix-class
16#
17#################
18
19
4f30591b 20my $sql = SQL::Abstract->new;
21
22my (@tests, $sub_stmt, @sub_bind, $where);
23
24#1
25($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
26 100, "foo%");
27$where = {
28 foo => 1234,
29 bar => \["IN ($sub_stmt)" => @sub_bind],
30 };
31push @tests, {
32 where => $where,
33 stmt => " WHERE ( bar IN (SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?) AND foo = ? )",
34 bind => [100, "foo%", 1234],
35};
36
37#2
38($sub_stmt, @sub_bind)
39 = $sql->select("t1", "c1", {c2 => {"<" => 100},
40 c3 => {-like => "foo%"}});
41$where = {
42 foo => 1234,
43 bar => \["> ALL ($sub_stmt)" => @sub_bind],
44 };
45push @tests, {
46 where => $where,
b9a4fdae 47 stmt => " WHERE ( bar > ALL (SELECT c1 FROM t1 WHERE (( c2 < ? AND c3 LIKE ? )) ) AND foo = ? )",
4f30591b 48 bind => [100, "foo%", 1234],
49};
50
51#3
52($sub_stmt, @sub_bind)
53 = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
54$where = {
55 foo => 1234,
56 -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
57 };
58push @tests, {
59 where => $where,
60 stmt => " WHERE ( EXISTS (SELECT * FROM t1 WHERE ( c1 = ? AND c2 > t0.c0 )) AND foo = ? )",
61 bind => [1, 1234],
62};
63
64#4
65$where = {
66 -nest => \["MATCH (col1, col2) AGAINST (?)" => "apples"],
67 };
68push @tests, {
69 where => $where,
70 stmt => " WHERE ( MATCH (col1, col2) AGAINST (?) )",
71 bind => ["apples"],
72};
73
74
75#5
76($sub_stmt, @sub_bind)
77 = $sql->where({age => [{"<" => 10}, {">" => 20}]});
78$sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
79$where = {
80 lname => {-like => '%son%'},
81 -nest => \["NOT ( $sub_stmt )" => @sub_bind],
82 };
83push @tests, {
84 where => $where,
85 stmt => " WHERE ( NOT ( ( ( ( age < ? ) OR ( age > ? ) ) ) ) AND lname LIKE ? )",
86 bind => [10, 20, '%son%'],
87};
88
89#6
90($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
91 100, "foo%");
92$where = {
93 foo => 1234,
94 bar => { -in => \[$sub_stmt => @sub_bind] },
95 };
96push @tests, {
97 where => $where,
98 stmt => " WHERE ( bar IN (SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?) AND foo = ? )",
99 bind => [100, "foo%", 1234],
100};
101
102
103plan tests => scalar(@tests);
104
105for (@tests) {
106
107 my($stmt, @bind) = $sql->where($_->{where}, $_->{order});
108 is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
109}
110
111
112
113
114