From 89b40554349ff77e986d1c6f584b9c9a28cf36af Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 25 Oct 2005 17:43:42 +0000 Subject: [PATCH] r10791: Automated commit for Debian build of clsql upstream-version-3.3.2 --- ChangeLog | 6 +++ debian/changelog | 6 +++ sql/expressions.lisp | 104 +++++++++++++++++++++++------------------ tests/test-syntax.lisp | 64 ++++++++++++++----------- 4 files changed, 106 insertions(+), 74 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1092414..2cd38be 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +26 Oct 2005 Kevin Rosenberg + * Version 3.3.2 + * sql/expressions.lisp: Avoid parenthesis on multiple group-by fields + as noted by Harald Hanche-Olsen. + * tests/test-syntax.lisp: Add test for multiple field group-by + 25 Oct 2005 Kevin Rosenberg * Version 3.3.1 * sql/time.lisp: Commit patch from Alan Shields to diff --git a/debian/changelog b/debian/changelog index 1e2b768..5a19448 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (3.3.2-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Tue, 25 Oct 2005 11:43:31 -0600 + cl-sql (3.3.1-1) unstable; urgency=low * New upstream diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 67fc6fa..e04180c 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -112,7 +112,7 @@ (defmethod output-sql ((expr sql-ident) database) (with-slots (name) expr (write-string - (convert-to-db-default-case + (convert-to-db-default-case (etypecase name (string name) (symbol (symbol-name name))) @@ -157,9 +157,9 @@ (string (write-string name *sql-stream*)) (symbol - (write-string (sql-escape (convert-to-db-default-case + (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *sql-stream*))) - + ;;; KMR: The TYPE field is used by CommonSQL for type conversion -- it ;;; should not be output in SQL statements #+ignore @@ -171,9 +171,9 @@ (convert-to-db-default-case (symbol-name type) database))) (format *sql-stream* "~@[~A.~]~A" (when qualifier - (typecase qualifier + (typecase qualifier (string (format nil "~s" qualifier)) - (t (convert-to-db-default-case (sql-escape qualifier) + (t (convert-to-db-default-case (sql-escape qualifier) database)))) (sql-escape (convert-to-db-default-case name database)))) t)) @@ -269,7 +269,7 @@ (defclass sql-upcase-like (sql-relational-exp) () (:documentation "An SQL 'like' that upcases its arguments.")) - + (defmethod output-sql ((expr sql-upcase-like) database) (flet ((write-term (term) (write-string "upper(" *sql-stream*) @@ -386,12 +386,12 @@ (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 + expr (output-sql (first args) database) (write-string " BETWEEN " *sql-stream*) (output-sql (second args) database) @@ -399,7 +399,7 @@ (output-sql (third args) database)) t) -(defclass sql-query-modifier-exp (%sql-expression) +(defclass sql-query-modifier-exp (%sql-expression) ((modifier :initarg :modifier :initform nil) (components :initarg :components :initform nil)) (:documentation "An SQL query modifier expression.")) @@ -410,8 +410,8 @@ (output-sql modifier database) (write-string " " *sql-stream*) (output-sql (car components) database) - (when components - (mapc #'(lambda (comp) + (when components + (mapc #'(lambda (comp) (write-string ", " *sql-stream*) (output-sql comp database)) (cdr components)))) @@ -545,13 +545,13 @@ uninclusive, and the args from that keyword to the end." target-args)))) (multiple-value-bind (selections arglist) (query-get-selections args) - (if (select-objects selections) + (if (select-objects selections) (destructuring-bind (&key flatp refresh &allow-other-keys) arglist (make-instance 'sql-object-query :objects selections :flatp flatp :refresh refresh :exp arglist)) (destructuring-bind (&key all flatp set-operation distinct from where - group-by having order-by + group-by having order-by offset limit inner-join on &allow-other-keys) arglist (if (null selections) @@ -567,12 +567,12 @@ uninclusive, and the args from that keyword to the end." (defmethod output-sql ((query sql-query) database) (with-slots (distinct selections from where group-by having order-by - limit offset inner-join on all set-operation) + limit offset inner-join on all set-operation) query (when *in-subselect* (write-string "(" *sql-stream*)) (write-string "SELECT " *sql-stream*) - (when all + (when all (write-string "ALL " *sql-stream*)) (when (and distinct (not all)) (write-string "DISTINCT " *sql-stream*) @@ -583,7 +583,7 @@ uninclusive, and the args from that keyword to the end." (output-sql (apply #'vector selections) database) (when from (write-string " FROM " *sql-stream*) - (flet ((ident-table-equal (a b) + (flet ((ident-table-equal (a b) (and (if (and (eql (type-of a) 'sql-ident-table) (eql (type-of b) 'sql-ident-table)) (string-equal (slot-value a 'alias) @@ -591,9 +591,9 @@ uninclusive, and the args from that keyword to the end." t) (string-equal (symbol-name (slot-value a 'name)) (symbol-name (slot-value b 'name)))))) - (typecase from - (list (output-sql (apply #'vector - (remove-duplicates from + (typecase from + (list (output-sql (apply #'vector + (remove-duplicates from :test #'ident-table-equal)) database)) (string (write-string from *sql-stream*)) @@ -610,7 +610,19 @@ uninclusive, and the args from that keyword to the end." (output-sql where database))) (when group-by (write-string " GROUP BY " *sql-stream*) - (output-sql group-by database)) + (if (listp group-by) + (do ((order group-by (cdr order))) + ((null order)) + (let ((item (car order))) + (typecase item + (cons + (output-sql (car item) database) + (format *sql-stream* " ~A" (cadr item))) + (t + (output-sql item database))) + (when (cdr order) + (write-char #\, *sql-stream*)))) + (output-sql group-by database))) (when having (write-string " HAVING " *sql-stream*) (output-sql having database)) @@ -620,11 +632,11 @@ uninclusive, and the args from that keyword to the end." (do ((order order-by (cdr order))) ((null order)) (let ((item (car order))) - (typecase item - (cons + (typecase item + (cons (output-sql (car item) database) (format *sql-stream* " ~A" (cadr item))) - (t + (t (output-sql item database))) (when (cdr order) (write-char #\, *sql-stream*)))) @@ -637,7 +649,7 @@ uninclusive, and the args from that keyword to the end." (output-sql offset database)) (when *in-subselect* (write-string ")" *sql-stream*)) - (when set-operation + (when set-operation (write-char #\Space *sql-stream*) (output-sql set-operation database))) t) @@ -672,10 +684,10 @@ uninclusive, and the args from that keyword to the end." (with-slots (into attributes values query) ins (write-string "INSERT INTO " *sql-stream*) - (output-sql + (output-sql (typecase into (string (sql-expression :attribute into)) - (t into)) + (t into)) database) (when attributes (write-char #\Space *sql-stream*) @@ -785,7 +797,7 @@ uninclusive, and the args from that keyword to the end." (database-get-type-specifier (car type) (cdr type) database (database-underlying-type database))) *sql-stream*) - (let ((constraints (database-constraint-statement + (let ((constraints (database-constraint-statement (if (and db-type (symbolp db-type)) (cons db-type constraints) constraints) @@ -812,7 +824,7 @@ uninclusive, and the args from that keyword to the end." (when (and (eq :mysql (database-underlying-type database)) transactions (db-type-transaction-capable? :mysql database)) - (write-string " Type=InnoDB" *sql-stream*)))) + (write-string " Type=InnoDB" *sql-stream*)))) t) @@ -837,8 +849,8 @@ uninclusive, and the args from that keyword to the end." ;; -;; DATABASE-OUTPUT-SQL -;; +;; DATABASE-OUTPUT-SQL +;; (defmethod database-output-sql ((str string) database) (declare (optimize (speed 3) (safety 1) @@ -864,8 +876,8 @@ uninclusive, and the args from that keyword to the end." (incf j) (setf (aref buf j) #\')) ((and (char= char #\\) - ;; MTP: only escape backslash with pgsql/mysql - (member (database-underlying-type database) + ;; MTP: only escape backslash with pgsql/mysql + (member (database-underlying-type database) '(:postgresql :mysql) :test #'eq)) (setf (aref buf j) #\\) @@ -876,8 +888,8 @@ uninclusive, and the args from that keyword to the end." (let ((keyword-package (symbol-package :foo))) (defmethod database-output-sql ((sym symbol) database) - (if (null sym) - +null-string+ + (if (null sym) + +null-string+ (convert-to-db-default-case (if (equal (symbol-package sym) keyword-package) (concatenate 'string "'" (string sym) "'") @@ -893,8 +905,8 @@ uninclusive, and the args from that keyword to the end." (princ-to-string num)) (defmethod database-output-sql ((arg list) database) - (if (null arg) - +null-string+ + (if (null arg) + +null-string+ (format nil "(~{~A~^,~})" (mapcar #'(lambda (val) (sql-output val database)) arg)))) @@ -922,7 +934,7 @@ uninclusive, and the args from that keyword to the end." (declare (ignore database)) (format nil "'~a'" (duration-timestring self))) -#+ignore +#+ignore (defmethod database-output-sql ((self money) database) (database-output-sql (slot-value self 'odcl::units) database)) @@ -938,26 +950,26 @@ uninclusive, and the args from that keyword to the end." ;; -;; Column constraint types and conversion to SQL +;; Column constraint types and conversion to SQL ;; (defparameter *constraint-types* - (list - (cons (symbol-name-default-case "NOT-NULL") "NOT NULL") + (list + (cons (symbol-name-default-case "NOT-NULL") "NOT NULL") (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY") - (cons (symbol-name-default-case "NOT") "NOT") - (cons (symbol-name-default-case "NULL") "NULL") - (cons (symbol-name-default-case "PRIMARY") "PRIMARY") + (cons (symbol-name-default-case "NOT") "NOT") + (cons (symbol-name-default-case "NULL") "NULL") + (cons (symbol-name-default-case "PRIMARY") "PRIMARY") (cons (symbol-name-default-case "KEY") "KEY") - (cons (symbol-name-default-case "UNSIGNED") "UNSIGNED") - (cons (symbol-name-default-case "ZEROFILL") "ZEROFILL") + (cons (symbol-name-default-case "UNSIGNED") "UNSIGNED") + (cons (symbol-name-default-case "ZEROFILL") "ZEROFILL") (cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT") (cons (symbol-name-default-case "UNIQUE") "UNIQUE"))) (defmethod database-constraint-statement (constraint-list database) (declare (ignore database)) (make-constraints-description constraint-list)) - + (defun make-constraints-description (constraint-list) (if constraint-list (let ((string "")) diff --git a/tests/test-syntax.lisp b/tests/test-syntax.lisp index 04ea99c..ea2f614 100644 --- a/tests/test-syntax.lisp +++ b/tests/test-syntax.lisp @@ -9,7 +9,7 @@ ;;;; Description ========================================================== ;;;; ====================================================================== ;;;; -;;;; Tests for the CLSQL Symbolic SQL syntax. +;;;; Tests for the CLSQL Symbolic SQL syntax. ;;;; ;;;; ====================================================================== @@ -19,7 +19,7 @@ (setq *rt-syntax* '( - + (deftest :syntax/generic/1 (clsql:sql "foo") "'foo'") @@ -40,8 +40,8 @@ (clsql:sql ["SELECT FOO,BAR FROM BAZ"]) "SELECT FOO,BAR FROM BAZ") -(deftest :syntax/generic/6 - (clsql:sql "What's up Doc?") +(deftest :syntax/generic/6 + (clsql:sql "What's up Doc?") "'What''s up Doc?'") (deftest :syntax/ident/1 @@ -95,7 +95,7 @@ "SOME((FOO,BAR,BAZ))") -(deftest :syntax/aggregate/1 +(deftest :syntax/aggregate/1 (clsql:sql [max [+ [foo] [* 1000 [bar]]]]) "MAX((FOO + (1000 * BAR)))") @@ -116,7 +116,7 @@ "COUNT(FOO)") -(deftest :syntax/logical/1 +(deftest :syntax/logical/1 (clsql:sql [and [foo] [bar]]) "(FOO AND BAR)") @@ -124,19 +124,19 @@ (clsql:sql [or [foo] [bar]]) "(FOO OR BAR)") -(deftest :syntax/logical/3 +(deftest :syntax/logical/3 (clsql:sql [not [foo]]) "(NOT (FOO))") -(deftest :syntax/null/1 +(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") @@ -173,16 +173,16 @@ "(BAZ <> BEEP)") -(deftest :syntax/between/1 +(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 +(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 +(deftest :syntax/arithmetic/1 (clsql:sql [+ [foo bar] [baz]]) "(FOO.BAR + BAZ)") @@ -207,16 +207,16 @@ "(2 * 3)") -(deftest :syntax/substr/1 +(deftest :syntax/substr/1 (clsql:sql [substr [hello] 1 4]) "SUBSTR(HELLO,1,4)") -(deftest :syntax/substring/1 +(deftest :syntax/substring/1 (clsql:sql [substring [hello] 1 4]) "SUBSTRING(HELLO,1,4)") -(deftest :syntax/concat/1 +(deftest :syntax/concat/1 (clsql:sql [|| [foo] [bar] [baz]]) "(FOO || BAR || BAZ)") @@ -225,7 +225,7 @@ "CONCAT(FOO,BAR)") -(deftest :syntax/pattern/1 +(deftest :syntax/pattern/1 (clsql:sql [like [foo] "%v"]) "(FOO LIKE '%v')") @@ -234,7 +234,7 @@ "(NOT ((FOO LIKE '%v')))") -(deftest :syntax/distinct/1 +(deftest :syntax/distinct/1 (clsql:sql [distinct [foo bar :string]]) "DISTINCT FOO.BAR") @@ -243,16 +243,24 @@ "DISTINCT FOO, BAR") -(deftest :syntax/order-by/1 +(deftest :syntax/order-by/1 (clsql:sql [order-by [foo]]) "ORDER BY FOO") -(deftest :syntax/group-by/1 +(deftest :syntax/group-by/1 (clsql:sql [group-by [foo]]) "GROUP BY FOO") +(deftest :syntax/group-by/2 + (clsql:sql + (clsql-sys::make-query [foo] [bar] [count [foo]] + :from [table] + :group-by '([foo] [bar]) + :order-by '([foo] [bar]))) + "SELECT FOO,BAR,COUNT(FOO) FROM TABLE GROUP BY FOO,BAR ORDER BY FOO,BAR") + -(deftest :syntax/coalesce/1 +(deftest :syntax/coalesce/1 (clsql:sql [coalesce [foo] [bar] "not specified"]) "COALESCE(FOO,BAR,'not specified')") @@ -260,17 +268,17 @@ (clsql:sql [nvl [foo] "not specified"]) "COALESCE(FOO,'not specified')") -(deftest :syntax/nvl/1 +(deftest :syntax/nvl/1 (clsql:sql [nvl [foo] "not specified"]) "COALESCE(FOO,'not specified')") -(deftest :syntax/sets/1 +(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 +(deftest :syntax/sets/2 (clsql:sql [intersect [select [foo] :from [bar]] [select [baz] :from [bar]]]) "SELECT FOO FROM BAR INTERSECT SELECT BAZ FROM BAR") @@ -296,7 +304,7 @@ (clsql:sql [select [person_id] [surname] :from [person]]) "SELECT PERSON_ID,SURNAME FROM PERSON") -(deftest :syntax/query/2 +(deftest :syntax/query/2 (clsql:sql [select [foo] [bar *] :from '([baz] [bar]) :where [or [= [foo] 3] @@ -313,7 +321,7 @@ (deftest :syntax/query/4 (clsql:sql [select [count [*]] :from [emp]]) "SELECT COUNT(*) FROM EMP") - + (deftest :syntax/expression1 (clsql:sql @@ -321,11 +329,11 @@ 'select (clsql:sql-expression :table 'foo :attribute 'bar) (clsql:sql-expression :attribute 'baz) - :from (list + :from (list (clsql:sql-expression :table 'foo) (clsql:sql-expression :table 'quux)) :where - (clsql:sql-operation 'or + (clsql:sql-operation 'or (clsql:sql-operation '> (clsql:sql-expression :attribute 'baz) @@ -336,7 +344,7 @@ :attribute 'bar) "SU%")))) "SELECT FOO.BAR,BAZ FROM FOO,QUUX WHERE ((BAZ > 3) OR (FOO.BAR LIKE 'SU%'))") - + (deftest :syntax/expression/2 (clsql:sql (apply (clsql:sql-operator 'and) -- 2.34.1