From 71ac7a8d3e5bea99472b07fa2a089c7173abb1f7 Mon Sep 17 00:00:00 2001 From: Marcus Pearce Date: Sat, 8 May 2004 19:30:57 +0000 Subject: [PATCH] r9289: Added new operations for the sql syntax. --- ChangeLog | 12 +++ TODO | 15 +--- sql/classes.lisp | 66 ++++++++++++++++ sql/operations.lisp | 60 +++++++++----- tests/test-fdml.lisp | 61 +++++++++++++++ tests/test-init.lisp | 9 ++- tests/test-syntax.lisp | 174 ++++++++++++++++++++++++++++++++++++++++- 7 files changed, 360 insertions(+), 37 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7677b3e..a7e3054 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +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. diff --git a/TODO b/TODO index 07c9c78..4042e64 100644 --- a/TODO +++ b/TODO @@ -26,17 +26,10 @@ COMMONSQL SPEC 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 diff --git a/sql/classes.lisp b/sql/classes.lisp index aa7a185..e7bc74e 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -378,6 +378,72 @@ (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 diff --git a/sql/operations.lisp b/sql/operations.lisp index 177acbd..f05df97 100644 --- a/sql/operations.lisp +++ b/sql/operations.lisp @@ -40,6 +40,10 @@ (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)) @@ -49,33 +53,41 @@ :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") () @@ -89,7 +101,6 @@ (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) @@ -128,9 +139,15 @@ (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 @@ -193,9 +210,12 @@ (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)) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index a4b8bb1..93d3597 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -154,6 +154,31 @@ '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*) @@ -313,6 +338,42 @@ :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]]]] diff --git a/tests/test-init.lisp b/tests/test-init.lisp index c899867..65b1d8a 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -539,11 +539,16 @@ (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 () diff --git a/tests/test-syntax.lisp b/tests/test-syntax.lisp index 9de62fe..ac8247e 100644 --- a/tests/test-syntax.lisp +++ b/tests/test-syntax.lisp @@ -69,13 +69,78 @@ (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 @@ -87,6 +152,106 @@ (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]]) @@ -96,6 +261,7 @@ (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") -- 2.34.1