Merge branch 'accel' of /var/git/clsql/ into accel

[clsql.git] / sql / expressions.lisp

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 91a46d7fb2c6c30592056c6ea98c2c25e260aee7..16e967bee67d2a4f07e66f0a22a22955a6b275e0 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -257,6 +257,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,13 +587,17 @@ 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)
         (write-string "ON " *sql-stream*)
         (output-sql distinct database)
         (write-char #\Space *sql-stream*)))
-    (output-sql (apply #'vector selections) database)
+    (let ((*in-subselect* t))
+      (output-sql (apply #'vector selections) database))
     (when from
       (write-string " FROM " *sql-stream*)
       (flet ((ident-table-equal (a b)
@@ -633,7 +659,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
@@ -966,7 +992,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))