X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=80fffc5277f66d8c8673abc4f56d99d694032508;hb=6bf69ed2c616ea75e5402bd95853adee5551743b;hp=6aaededd7c6b32aa1c58337c9257fc6e400d29a8;hpb=581e3910304b4054f41b0cb41105b03519af63b1;p=clsql.git diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 6aaeded..80fffc5 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -110,6 +110,7 @@ `(make-instance 'sql-ident :name ',name))) (defmethod output-sql ((expr sql-ident) database) + (with-slots (name) expr (write-string (etypecase name @@ -169,10 +170,10 @@ (when qualifier (typecase qualifier (string (format nil "~s" qualifier)) - (t (sql-escape qualifier)))) + (t (format nil "~s" (sql-escape qualifier))))) (typecase name (string (format nil "~s" (sql-escape name))) - (t (sql-escape name))))) + (t (format nil "~s" (sql-escape name)))))) t)) (defmethod output-sql-hash-key ((expr sql-ident-attribute) database) @@ -257,6 +258,28 @@ (write-char #\) *sql-stream*))) t) +(defclass sql-array-exp (sql-relational-exp) + () + (:documentation "An SQL relational expression.")) + +(defmethod output-sql ((expr sql-array-exp) database) + (with-slots (operator sub-expressions) + expr + (let ((subs (if (consp (car sub-expressions)) + (car sub-expressions) + sub-expressions))) + (write-char #\( *sql-stream*) + (output-sql operator database) + (write-char #\[ *sql-stream*) + (do ((sub subs (cdr sub))) + ((null (cdr sub)) (output-sql (car sub) database)) + (output-sql (car sub) database) + (write-char #\, *sql-stream*) + (write-char #\Space *sql-stream*)) + (write-char #\] *sql-stream*) + (write-char #\) *sql-stream*))) + t) + (defclass sql-upcase-like (sql-relational-exp) () (:documentation "An SQL 'like' that upcases its arguments.")) @@ -565,6 +588,9 @@ uninclusive, and the args from that keyword to the end." (write-string "SELECT " *sql-stream*) (when all (write-string "ALL " *sql-stream*)) + (when (and limit (eq :odbc (database-type database))) + (write-string " TOP " *sql-stream*) + (output-sql limit database)) (when (and distinct (not all)) (write-string "DISTINCT " *sql-stream*) (unless (eql t distinct) @@ -634,7 +660,7 @@ uninclusive, and the args from that keyword to the end." (when (cdr order) (write-char #\, *sql-stream*)))) (output-sql order-by database))) - (when limit + (when (and limit (not (eq :odbc (database-type database)))) (write-string " LIMIT " *sql-stream*) (output-sql limit database)) (when offset @@ -967,7 +993,9 @@ uninclusive, and the args from that keyword to the end." (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"))) + (cons (symbol-name-default-case "UNIQUE") "UNIQUE") + (cons (symbol-name-default-case "IDENTITY") "IDENTITY (1,1)") ;Added Identity for MS-SQLServer support + )) (defmethod database-constraint-statement (constraint-list database) (declare (ignore database))