+8 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
+ * sql/operations.lisp: complete remaining operations for the sql
+ syntax: SUBSTR, SOME, ORDER-BY, GROUP-BY, NULL, DISTINCT, EXCEPT,
+ UNION, INTERSECT, BETWEEN.
+ * sql/classes.lisp: add new classes: SQL-BETWEEN-EXPRESSION,
+ SQL-QUERY-MODIFIER-EXPRESSION and SQL-SET-EXPRESSION.
+ * tests/test-syntax.lisp: add tests for new operations.
+ * tests/test-fdml.lisp: add tests for queries based on new operations.
+ * tests/test-init.lisp: add select/20 to tests skipped for sqlite and
+ select/20, query/5, query/7 and query/8 to tests skipped by mysql.
+ * TODO: removed entries done.
+
8 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
* tests/benchmarks.lisp: Add immediate vs. deferred
join test.
o Complete sql expressions (see operations.lisp)
- substr
- some
- order-by
- times
- nvl
- null
- distinct
- except
- intersect
- between
- userenv
+ nvl (Oracle specific)
+ userenv (Oracle specific)
+ minus (Oracle specific: does the same as EXCEPT)
+ ||
o variables (e.g., table identifiers) should be instantiated at runtime
(when args (output-sql args database)))
t)
+
+(defclass sql-between-exp (sql-function-exp)
+ ()
+ (:documentation "An SQL between expression."))
+
+(defmethod output-sql ((expr sql-between-exp) database)
+ (with-slots (name args)
+ expr
+ (output-sql (first args) database)
+ (write-string " BETWEEN " *sql-stream*)
+ (output-sql (second args) database)
+ (write-string " AND " *sql-stream*)
+ (output-sql (third args) database))
+ t)
+
+(defclass sql-query-modifier-exp (%sql-expression)
+ ((modifier :initarg :modifier :initform nil)
+ (components :initarg :components :initform nil))
+ (:documentation "An SQL query modifier expression."))
+
+(defmethod output-sql ((expr sql-query-modifier-exp) database)
+ (with-slots (modifier components)
+ expr
+ (output-sql modifier database)
+ (write-string " " *sql-stream*)
+ (output-sql (car components) database)
+ (when components
+ (mapc #'(lambda (comp)
+ (write-string ", " *sql-stream*)
+ (output-sql comp database))
+ (cdr components))))
+ t)
+
+(defclass sql-set-exp (%sql-expression)
+ ((operator
+ :initarg :operator
+ :initform nil)
+ (sub-expressions
+ :initarg :sub-expressions
+ :initform nil))
+ (:documentation "An SQL set expression."))
+
+(defmethod collect-table-refs ((sql sql-set-exp))
+ (let ((tabs nil))
+ (dolist (exp (slot-value sql 'sub-expressions))
+ (let ((refs (collect-table-refs exp)))
+ (if refs (setf tabs (append refs tabs)))))
+ (remove-duplicates tabs
+ :test (lambda (tab1 tab2)
+ (equal (slot-value tab1 'name)
+ (slot-value tab2 'name))))))
+
+(defmethod output-sql ((expr sql-set-exp) database)
+ (with-slots (operator sub-expressions)
+ expr
+ (let ((subs (if (consp (car sub-expressions))
+ (car sub-expressions)
+ sub-expressions)))
+ (do ((sub subs (cdr sub)))
+ ((null (cdr sub)) (output-sql (car sub) database))
+ (output-sql (car sub) database)
+ (write-char #\Space *sql-stream*)
+ (output-sql operator database)
+ (write-char #\Space *sql-stream*))))
+ t)
+
(defclass sql-query (%sql-expression)
((selections
:initarg :selections
(make-instance 'sql-value-exp
:modifier 'any :components rest))
+(defsql sql-some (:symbol "some") (&rest rest)
+ (make-instance 'sql-value-exp
+ :modifier 'some :components rest))
+
(defsql sql-all (:symbol "all") (&rest rest)
(make-instance 'sql-value-exp
:modifier 'all :components rest))
:modifier 'not :components rest))
(defsql sql-union (:symbol "union") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'union :components rest))
+ (make-instance 'sql-set-exp
+ :operator 'union :sub-expressions rest))
(defsql sql-intersect (:symbol "intersect") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'intersect :components rest))
+ (make-instance 'sql-set-exp
+ :operator 'intersect :sub-expressions rest))
+
+(defsql sql-except (:symbol "except") (&rest rest)
+ (make-instance 'sql-set-exp
+ :operator 'except :sub-expressions rest))
(defsql sql-minus (:symbol "minus") (&rest rest)
(make-instance 'sql-value-exp
:modifier 'minus :components rest))
-(defsql sql-group-by (:symbol "group-by") (&rest rest)
- (make-instance 'sql-value-exp
- :modifier 'group-by :components rest))
-
(defsql sql-limit (:symbol "limit") (&rest rest)
- (make-instance 'sql-value-exp
+ (make-instance 'sql-query-modifier-exp
:modifier 'limit :components rest))
+(defsql sql-group-by (:symbol "group-by") (&rest rest)
+ (make-instance 'sql-query-modifier-exp
+ :modifier '|group by| :components rest))
+
+(defsql sql-order-by (:symbol "order-by") (&rest rest)
+ (make-instance 'sql-query-modifier-exp
+ :modifier '|order by| :components rest))
+
(defsql sql-having (:symbol "having") (&rest rest)
- (make-instance 'sql-value-exp
+ (make-instance 'sql-query-modifier-exp
:modifier 'having :components rest))
(defsql sql-null (:symbol "null") (&rest rest)
(if rest
- (make-instance 'sql-relational-exp :operator '|IS NULL|
- :sub-expressions (list (car rest)))
+ (make-instance 'sql-relational-exp :operator 'is
+ :sub-expressions (list (car rest) nil))
(make-instance 'sql-value-exp :components 'null)))
(defsql sql-not-null (:symbol "not-null") ()
(defsql sql-* (:symbol "*") (&rest rest)
(if (zerop (length rest))
(make-instance 'sql-ident :name '*)
- ;(error 'clsql-sql-syntax-error :reason "'*' with arguments")))
(make-instance 'sql-relational-exp :operator '* :sub-expressions rest)))
(defsql sql-+ (:symbol "+") (&rest rest)
(make-instance 'sql-relational-exp
:operator 'in :sub-expressions rest))
-(defsql sql-|| (:symbol "||") (&rest rest)
- (make-instance 'sql-relational-exp
- :operator '|| :sub-expressions rest))
+(defsql sql-concat (:symbol "||") (&rest rest)
+ (make-instance 'sql-relational-exp
+ :operator '\|\| :sub-expressions rest))
+
+(defsql sql-substr (:symbol "substr") (&rest rest)
+ (if (= (length rest) 3)
+ (make-instance 'sql-function-exp
+ :name 'substring :args rest)
+ (error 'clsql-sql-syntax-error "SUBSTR must have 3 arguments.")))
(defsql sql-is (:symbol "is") (&rest rest)
(make-instance 'sql-relational-exp
(make-instance 'sql-function-exp
:name (make-symbol (car args)) :args (cdr args)))
-;;(defsql sql-distinct (:symbol "distinct") (&rest rest)
-;; nil)
+(defsql sql-between (:symbol "between") (&rest rest)
+ (if (= (length rest) 3)
+ (make-instance 'sql-between-exp :name 'between :args rest)
+ (error 'clsql-sql-syntax-error "BETWEEN must have 3 arguments.")))
-;;(defsql sql-between (:symbol "between") (&rest rest)
-;; nil)
+(defsql sql-distinct (:symbol "distinct") (&rest rest)
+ (make-instance 'sql-query-modifier-exp :modifier 'distinct
+ :components rest))
'float)
t)
+(deftest :fdml/query/5
+ (clsql:query (clsql:sql [select [first-name] [sum [emplid]] :from [employee]]
+ [group-by [first-name]] [order-by [sum [emplid]]])
+ :field-names nil :result-types nil)
+ (("Josef" "2") ("Leon" "3") ("Nikita" "4") ("Leonid" "5") ("Yuri" "6")
+ ("Konstantin" "7") ("Mikhail" "8") ("Boris" "9") ("Vladamir" "11")))
+
+(deftest :fdml/query/6
+ (clsql:query (clsql:sql [union [select [emplid] :from [employee]]
+ [select [groupid] :from [company]]])
+ :field-names nil :result-types nil :flatp t)
+ ("1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))
+
+(deftest :fdml/query/7
+ (clsql:query (clsql:sql [intersect [select [emplid] :from [employee]]
+ [select [groupid] :from [company]]])
+ :field-names nil :result-types nil :flatp t)
+ ("1"))
+
+(deftest :fdml/query/8
+ (clsql:query (clsql:sql [except [select [emplid] :from [employee]]
+ [select [groupid] :from [company]]])
+ :field-names nil :result-types nil :flatp t)
+ ("2" "3" "4" "5" "6" "7" "8" "9" "10"))
+
(deftest :fdml/execute-command/1
(values
(clsql:table-exists-p [foo] :owner *test-database-user*)
:field-names nil)
(("1" "Lenin")))
+(deftest :fdml/select/19
+ (clsql:select [emplid] :from [employee] :order-by [emplid]
+ :where [between [* [emplid] 10] [* 5 10] [* 10 10]]
+ :field-names nil :result-types nil :flatp t)
+ ("5" "6" "7" "8" "9" "10"))
+
+(deftest :fdml/select/20
+ (clsql:select [emplid] :from [employee] :order-by [emplid]
+ :where [not [between [* [emplid] 10] [* 5 10] [* 10 10]]]
+ :field-names nil :result-types nil :flatp t)
+ ("1" "2" "3" "4"))
+
+(deftest :fdml/select/20
+ (clsql:select [substr [first-name] 1 4] :from [employee]
+ :flatp t :order-by [emplid] :field-names nil)
+ ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
+
+(deftest :fdml/select/21
+ (clsql:select [\|\| [first-name] " " [last-name]] :from [employee]
+ :flatp t :order-by [emplid] :field-names nil)
+ ("Vladamir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev"
+ "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev"
+ "Boris Yeltsin" "Vladamir Putin"))
+
+(deftest :fdml/select/22
+ (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
+ :flatp t :order-by [emplid] :field-names nil
+ :result-types nil)
+ ("1" "2" "3" "4"))
+
+(deftest :fdml/select/23
+ (clsql:select [distinct [first-name]] :from [employee] :flatp t
+ :order-by [first-name] :field-names nil :result-types nil)
+ ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"
+ "Yuri"))
+
;(deftest :fdml/select/11
; (clsql:select [emplid] :from [employee]
; :where [= [emplid] [any [select [companyid] :from [company]]]]
(clsql-base::in test :fdml/select/1))
(push (cons test "fancy math not supported") skip-tests))
((and (eql *test-database-type* :sqlite)
- (clsql-base::in test :fddl/view/4 :fdml/select/10))
+ (clsql-base::in test :fddl/view/4 :fdml/select/10
+ :fdml/select/20))
(push (cons test "not supported by sqlite") skip-tests))
+ ((and (eql *test-database-type* :mysql)
+ (clsql-base::in test :fdml/select/21 :fdml/query/5
+ :fdml/query/7 :fdml/query/8))
+ (push (cons test "not supported by mysql") skip-tests))
(t
(push test-form test-forms)))))
- (values (nreverse test-forms) (nreverse skip-tests))))
+ (values (nreverse test-forms) (nreverse skip-tests))))
(defun rl ()
(clsql:sql ["foo" bar :integer])
"FOO.BAR")
-(deftest :syntax/value/1
+
+(deftest :syntax/subquery/1
(clsql:sql [any '(3 4)])
"(ANY ((3,4)))")
-(deftest :syntax/value/2
- (clsql:sql [* 2 3])
- "(2 * 3)")
+(deftest :syntax/subquery/2
+ (clsql:sql [in [foo] '(foo bar baz)])
+ "(FOO IN (FOO,BAR,BAZ))")
+
+(deftest :syntax/subquery/3
+ (clsql:sql [all '(foo bar baz)])
+ "(ALL ((FOO,BAR,BAZ)))")
+
+(deftest :syntax/subquery/4
+ (clsql:sql [exists '(foo bar baz)])
+ "(EXISTS ((FOO,BAR,BAZ)))")
+
+(deftest :syntax/subquery/5
+ (clsql:sql [some '(foo bar baz)])
+ "(SOME ((FOO,BAR,BAZ)))")
+
+
+(deftest :syntax/aggregate/1
+ (clsql:sql [max [+ [foo] [* 1000 [bar]]]])
+ "MAX((FOO + (1000 * BAR)))")
+
+(deftest :syntax/aggregate/2
+ (clsql:sql [avg [+ [foo] [* 1000 [bar]]]])
+ "AVG((FOO + (1000 * BAR)))")
+
+(deftest :syntax/aggregate/3
+ (clsql:sql [min [+ [foo] [* 1000 [bar]]]])
+ "MIN((FOO + (1000 * BAR)))")
+
+(deftest :syntax/aggregate/4
+ (clsql:sql [sum [foo] [bar]])
+ "SUM(FOO,BAR)")
+
+(deftest :syntax/aggregate/5
+ (clsql:sql [count [foo]])
+ "COUNT(FOO)")
+
+
+(deftest :syntax/logical/1
+ (clsql:sql [and [foo] [bar]])
+ "(FOO AND BAR)")
+
+(deftest :syntax/logical/2
+ (clsql:sql [or [foo] [bar]])
+ "(FOO OR BAR)")
+
+(deftest :syntax/logical/3
+ (clsql:sql [not [foo]])
+ "(NOT (FOO))")
+
+
+(deftest :syntax/null/1
+ (clsql:sql [null [foo]])
+ "(FOO IS NULL)")
+
+(deftest :syntax/null/2
+ (clsql:sql [not [null [foo]]])
+ "(NOT ((FOO IS NULL)))")
+
+(deftest :syntax/null/3
+ (clsql:sql [null])
+ "NULL")
+
+(deftest :syntax/null/4
+ (clsql:sql [not [null]])
+ "(NOT (NULL))")
+
(deftest :syntax/relational/1
(clsql:sql [> [foo] x]))
"(FOO > 10)")
+(deftest :syntax/relational/3
+ (clsql:sql [>= [baz] [beep]])
+ "(BAZ >= BEEP)")
+
+(deftest :syntax/relational/4
+ (clsql:sql [< [baz] [beep]])
+ "(BAZ < BEEP)")
+
+(deftest :syntax/relational/5
+ (clsql:sql [= [baz] [beep]])
+ "(BAZ = BEEP)")
+
+(deftest :syntax/relational/6
+ (clsql:sql [<> [baz] [beep]])
+ "(BAZ <> BEEP)")
+
+
+(deftest :syntax/between/1
+ (clsql:sql [between [- [foo] 1] [* [bar] 5] [/ [baz] 9]])
+ "(FOO - 1) BETWEEN (BAR * 5) AND (BAZ / 9)")
+
+(deftest :syntax/between/2
+ (clsql:sql [not [between [- [foo] 1] [* [bar] 5] [/ [baz] 9]]])
+ "(NOT ((FOO - 1) BETWEEN (BAR * 5) AND (BAZ / 9)))")
+
+
+(deftest :syntax/arithmetic/1
+ (clsql:sql [+ [foo bar] [baz]])
+ "(FOO.BAR + BAZ)")
+
+(deftest :syntax/arithmetic/2
+ (clsql:sql [- [foo bar] [baz]])
+ "(FOO.BAR - BAZ)")
+
+(deftest :syntax/arithmetic/3
+ (clsql:sql [/ [foo bar] [baz]])
+ "(FOO.BAR / BAZ)")
+
+(deftest :syntax/arithmetic/4
+ (clsql:sql [* [foo bar] [baz]])
+ "(FOO.BAR * BAZ)")
+
+(deftest :syntax/arithmetic/5
+ (clsql:sql [- [foo bar]])
+ "(- (FOO.BAR))")
+
+(deftest :syntax/arithmetic/6
+ (clsql:sql [* 2 3])
+ "(2 * 3)")
+
+
+(deftest :syntax/substr/1
+ (clsql:sql [substr [hello] 1 4])
+ "SUBSTRING(HELLO,1,4)")
+
+
+(deftest :syntax/concat/1
+ (clsql:sql [\|\| [foo] [bar] [baz]])
+ "(FOO || BAR || BAZ)")
+
+
+(deftest :syntax/pattern/1
+ (clsql:sql [like [foo] "%v"])
+ "(FOO LIKE '%v')")
+
+(deftest :syntax/pattern/2
+ (clsql:sql [not [like [foo] "%v"]])
+ "(NOT ((FOO LIKE '%v')))")
+
+
+(deftest :syntax/distinct/1
+ (clsql:sql [distinct [foo bar :string]])
+ "DISTINCT FOO.BAR")
+
+(deftest :syntax/distinct/2
+ (clsql:sql [distinct [foo :string] [bar :integer]])
+ "DISTINCT FOO, BAR")
+
+
+(deftest :syntax/order-by/1
+ (clsql:sql [order-by [foo]])
+ "ORDER BY FOO")
+
+(deftest :syntax/group-by/1
+ (clsql:sql [group-by [foo]])
+ "GROUP BY FOO")
+
+
+(deftest :syntax/sets/1
+ (clsql:sql [union [select [foo] :from [bar]] [select [baz] :from [bar]]])
+ "SELECT FOO FROM BAR UNION SELECT BAZ FROM BAR")
+
+(deftest :syntax/sets/2
+ (clsql:sql [intersect [select [foo] :from [bar]] [select [baz] :from [bar]]])
+ "SELECT FOO FROM BAR INTERSECT SELECT BAZ FROM BAR")
+
+(deftest :syntax/sets/3
+ (clsql:sql [except [select [foo] :from [bar]] [select [baz] :from [bar]]])
+ "SELECT FOO FROM BAR EXCEPT SELECT BAZ FROM BAR")
+
(deftest :syntax/function/1
(clsql:sql [function "COS" [age]])
(clsql:sql [function "TO_DATE" "02/06/99" "mm/DD/RR"])
"TO_DATE('02/06/99','mm/DD/RR')")
+
(deftest :syntax/query/1
(clsql:sql [select [person_id] [surname] :from [person]])
"SELECT PERSON_ID,SURNAME FROM PERSON")
projects / clsql.git / commitdiff