X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=b80806439c0ac71f13ab77e0a379e4e46cd0afbd;hb=e25a98d30a030b33bcb78d1903811b6e71963216;hp=c7236a454f56cb4c4c08a102c4ee61381c162996;hpb=f5cec2ab2ddaf094f58bdfd613f8b10eab127373;p=clsql.git diff --git a/sql/expressions.lisp b/sql/expressions.lisp index c7236a4..b808064 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -421,7 +421,7 @@ (defmethod output-sql ((expr sql-query-modifier-exp) database) (with-slots (modifier components) expr - (output-sql modifier database) + (%write-operator modifier database) (write-string " " *sql-stream*) (output-sql (car components) database) (when components @@ -586,10 +586,6 @@ uninclusive, and the args from that keyword to the end." (when *in-subselect* (write-string "(" *sql-stream*)) (write-string "SELECT " *sql-stream*) - (when (and limit (eql :mssql (database-underlying-type database))) - (write-string " TOP " *sql-stream*) - (output-sql limit database) - (write-string " " *sql-stream*)) (when all (write-string " ALL " *sql-stream*)) (when (and distinct (not all)) @@ -598,18 +594,24 @@ uninclusive, and the args from that keyword to the end." (write-string " ON " *sql-stream*) (output-sql distinct database) (write-char #\Space *sql-stream*))) + (when (and limit (eql :mssql (database-underlying-type database))) + (write-string " TOP " *sql-stream*) + (output-sql limit database) + (write-string " " *sql-stream*)) (let ((*in-subselect* t)) (output-sql (apply #'vector selections) database)) (when from (write-string " FROM " *sql-stream*) - (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) - (slot-value b 'alias)) - t) - (string-equal (sql-escape (slot-value a 'name)) - (sql-escape (slot-value b 'name)))))) + (labels ((ident-string-val (a) + (typecase a + (sql-ident + (or (ignore-errors (slot-value a 'alias)) + (ignore-errors (slot-value a 'name)))) + (string a))) + (ident-table-equal (a b) + ;; The things should be type compatable + (string-equal (ident-string-val a) + (ident-string-val b)))) (typecase from (list (output-sql (apply #'vector (remove-duplicates from @@ -625,9 +627,14 @@ uninclusive, and the args from that keyword to the end." (write-string " ON " *sql-stream*) (output-sql on database)) (when where - (write-string " WHERE " *sql-stream*) - (let ((*in-subselect* t)) - (output-sql where database))) + (let ((where-out (string-trim + '(#\newline #\space #\tab #\return) + (with-output-to-string (*sql-stream*) + (let ((*in-subselect* t)) + (output-sql where database)))))) + (when (> (length where-out) 0) + (write-string " WHERE " *sql-stream*) + (write-string where-out *sql-stream*)))) (when group-by (write-string " GROUP BY " *sql-stream*) (if (listp group-by)