From fd2493718d0e1114fcbe3dd578dab658ea383e81 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 26 Nov 2005 16:08:12 +0000 Subject: [PATCH] r10845: 26 Nov 2005 Kevin Rosenberg * Version 3.5.0 * tests/test-init.lisp, tests/test-fddl.lisp, tests/test-fdml.lisp, * db-odbc/odbc-api.lisp, db-odbc/odbc-ff-interface.lisp, * db-odbc/odbc-package.lisp, db-odbc/odbc-constants.lisp * db-odbc/odbc-dbi.lisp, db-odbc/odbc-sql.lisp * sql/fddl.lisp, sql/generic-odbc.lisp, sql/db-interface.lisp * sql/transaction.lisp, sql/package.lisp, sql/time.lisp Commit patch from Dominic Robinson providing support for Microsoft SQL Server * doc/csql.lisp: Fix typo in slot name --- ChangeLog | 12 ++++ db-odbc/odbc-api.lisp | 113 +++++++++++++++++++-------------- db-odbc/odbc-constants.lisp | 2 + db-odbc/odbc-dbi.lisp | 18 ++++-- db-odbc/odbc-ff-interface.lisp | 2 +- db-odbc/odbc-package.lisp | 1 + db-odbc/odbc-sql.lisp | 20 ++++-- debian/changelog | 7 ++ debian/control | 4 +- doc/csql.xml | 2 +- sql/db-interface.lisp | 17 +++++ sql/fddl.lisp | 16 ++--- sql/generic-odbc.lisp | 85 ++++++++++++++++++++++--- sql/package.lisp | 3 + sql/time.lisp | 2 +- sql/transaction.lisp | 6 +- tests/test-fddl.lisp | 10 ++- tests/test-fdml.lisp | 7 +- tests/test-init.lisp | 9 +++ 19 files changed, 247 insertions(+), 89 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4e2d6a2..04aa5fb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +26 Nov 2005 Kevin Rosenberg + * Version 3.5.0 + * tests/test-init.lisp, tests/test-fddl.lisp, tests/test-fdml.lisp, + * db-odbc/odbc-api.lisp, db-odbc/odbc-ff-interface.lisp, + * db-odbc/odbc-package.lisp, db-odbc/odbc-constants.lisp + * db-odbc/odbc-dbi.lisp, db-odbc/odbc-sql.lisp + * sql/fddl.lisp, sql/generic-odbc.lisp, sql/db-interface.lisp + * sql/transaction.lisp, sql/package.lisp, sql/time.lisp + Commit patch from Dominic Robinson providing support for + Microsoft SQL Server + * doc/csql.lisp: Fix typo in slot name + 24 Nov 2005 Kevin Rosenberg * Version 3.4.7 * sql/time.lisp: Commit patch from Aleksandar Bakic for diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 0dcefa4..33734bc 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -198,6 +198,20 @@ as possible second argument) to the desired representation of date/time/timestam (SQLConnect hdbc server-ptr $SQL_NTS uid-ptr $SQL_NTS pwd-ptr $SQL_NTS)))) +(defun %sql-driver-connect (hdbc connection-string completion window-handle) + (with-cstring (connection-ptr connection-string) + (let ((completed-connection-string (allocate-foreign-string $SQL_MAX_CONN_OUT))) + (unwind-protect + (with-foreign-object (completed-connection-length :short) + (with-error-handling + (:hdbc hdbc) + (SQLDriverConnect hdbc + window-handle + connection-ptr $SQL_NTS + completed-connection-string $SQL_MAX_CONN_OUT + completed-connection-length + completion))) + (free-foreign-object completed-connection-string))))) (defun %disconnect (hdbc) (with-error-handling @@ -560,7 +574,7 @@ as possible second argument) to the desired representation of date/time/timestam (defun sql-to-c-type (sql-type) (ecase sql-type ((#.$SQL_CHAR #.$SQL_VARCHAR #.$SQL_LONGVARCHAR - #.$SQL_NUMERIC #.$SQL_DECIMAL #.$SQL_BIGINT -8 -9) $SQL_C_CHAR) + #.$SQL_NUMERIC #.$SQL_DECIMAL #.$SQL_BIGINT -8 -9 -10) $SQL_C_CHAR) ;; Added -10 for MSSQL ntext type (#.$SQL_INTEGER $SQL_C_SLONG) (#.$SQL_SMALLINT $SQL_C_SSHORT) (#.$SQL_DOUBLE $SQL_C_DOUBLE) @@ -848,56 +862,59 @@ as possible second argument) to the desired representation of date/time/timestam (defun read-data-in-chunks (hstmt column-nr data-ptr c-type sql-type out-len-ptr result-type) - (declare (type long-ptr-type out-len-ptr)) + (declare (type long-ptr-type out-len-ptr) + (ignore result-type)) (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr +max-precision+ out-len-ptr)) (out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)) - (offset 0)) - (case out-len - (#.$SQL_NULL_DATA - (return-from read-data-in-chunks *null*)) - (#.$SQL_NO_TOTAL ;; don't know how long it is going to be - (let ((str (make-array 0 :element-type 'character :adjustable t))) - (loop do (if (= c-type #.$SQL_CHAR) - (let ((data-length (foreign-string-length data-ptr))) - (adjust-array str (+ offset data-length) - :initial-element #\?) - (setf offset (%cstring-into-vector - data-ptr str - offset - data-length))) - (error 'clsql:sql-database-error :message "wrong type. preliminary.")) - while (and (= res $SQL_SUCCESS_WITH_INFO) - (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) - "01004")) - do (setf res (%sql-get-data hstmt column-nr c-type data-ptr - +max-precision+ out-len-ptr))) - (setf str (coerce str 'string)) - (if (= sql-type $SQL_DECIMAL) - (let ((*read-base* 10)) - (read-from-string str)) - str))) - (otherwise - (let ((str (make-string out-len))) - (loop do (if (= c-type #.$SQL_CHAR) - (setf offset (%cstring-into-vector ;string - data-ptr str - offset - (min out-len (1- +max-precision+)))) - (error 'clsql:sql-database-error :message "wrong type. preliminary.")) - while - (and (= res $SQL_SUCCESS_WITH_INFO) - #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) - $sql-data-truncated) - (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) - "01004")) - do (setf res (%sql-get-data hstmt column-nr c-type data-ptr - +max-precision+ out-len-ptr) - out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))) - (if (= sql-type $SQL_DECIMAL) - (let ((*read-base* 10)) - (read-from-string str)) - str)))))) + (offset 0) + (result (case out-len + (#.$SQL_NULL_DATA + (return-from read-data-in-chunks *null*)) + (#.$SQL_NO_TOTAL ;; don't know how long it is going to be + (let ((str (make-array 0 :element-type 'character :adjustable t))) + (loop do (if (= c-type #.$SQL_CHAR) + (let ((data-length (foreign-string-length data-ptr))) + (adjust-array str (+ offset data-length) + :initial-element #\?) + (setf offset (%cstring-into-vector + data-ptr str + offset + data-length))) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) + while (and (= res $SQL_SUCCESS_WITH_INFO) + (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) + "01004")) + do (setf res (%sql-get-data hstmt column-nr c-type data-ptr + +max-precision+ out-len-ptr))) + (setf str (coerce str 'string)) + (if (= sql-type $SQL_DECIMAL) + (let ((*read-base* 10)) + (read-from-string str)) + str))) + (otherwise + (let ((str (make-string out-len))) + (loop do (if (= c-type #.$SQL_CHAR) + (setf offset (%cstring-into-vector ;string + data-ptr str + offset + (min out-len (1- +max-precision+)))) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) + while + (and (= res $SQL_SUCCESS_WITH_INFO) + #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) + $sql-data-truncated) + (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) + "01004")) + do (setf res (%sql-get-data hstmt column-nr c-type data-ptr + +max-precision+ out-len-ptr) + out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))) + (if (= sql-type $SQL_DECIMAL) + (let ((*read-base* 10)) + (read-from-string str)) + str)))))) + (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row + result)) (def-type c-timestamp-ptr-type (* (:struct sql-c-timestamp))) (def-type c-time-ptr-type (* (:struct sql-c-time))) diff --git a/db-odbc/odbc-constants.lisp b/db-odbc/odbc-constants.lisp index 0315e44..6d8a183 100644 --- a/db-odbc/odbc-constants.lisp +++ b/db-odbc/odbc-constants.lisp @@ -953,6 +953,8 @@ (defconstant $SQL_DRIVER_PROMPT 2) (defconstant $SQL_DRIVER_COMPLETE_REQUIRED 3) +(defconstant $SQL_MAX_CONN_OUT 1024) + ;; Level 2 Functions ;; SQLExtendedFetch "fFetchType" values diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index fc8f300..2a60462 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -124,12 +124,21 @@ the query against." )) ;;; AODBC Compatible interface -(defun connect (&key data-source-name user password (autocommit t)) +(defun connect (&key data-source-name user password connection-string completion window-handle (autocommit t)) (let ((db (make-instance 'odbc-db))) (unless (henv db) ;; has class allocation! (setf (henv db) (%new-environment-handle))) (setf (hdbc db) (%new-db-connection-handle (henv db))) - (%sql-connect (hdbc db) data-source-name user password) + (if connection-string + (%sql-driver-connect (hdbc db) + connection-string + (ecase completion + (:no-prompt odbc::$SQL_DRIVER_NOPROMPT) + (:complete odbc::$SQL_DRIVER_COMPLETE) + (:prompt odbc::$SQL_DRIVER_PROMPT) + (:complete-required odbc::$SQL_DRIVER_COMPLETE_REQUIRED)) + window-handle) + (%sql-connect (hdbc db) data-source-name user password)) #+ignore (setf (db-hstmt db) (%new-statement-handle (hdbc db))) (when (/= (get-odbc-info db odbc::$SQL_TXN_CAPABLE) odbc::$SQL_TC_NONE) (if autocommit @@ -217,7 +226,7 @@ the query against." )) (defun list-all-table-columns (table &key db hstmt) (declare (ignore hstmt)) - (db-describe-columns db "" "" table "")) + (db-describe-columns db nil nil table nil)) ;; use nil rather than "" for unspecified values (defun list-all-data-sources () (let ((db (make-instance 'odbc-db))) @@ -424,7 +433,8 @@ This makes the functions db-execute-command and db-query thread safe." ;; allocate space to bind result rows to (multiple-value-bind (c-type data-ptr out-len-ptr size long-p) (%allocate-bindings sql-type precision) - (unless long-p ;; if long-p we fetch in chunks with %sql-get-data + (if long-p ;; if long-p we fetch in chunks with %sql-get-data but must ensure that out_len_ptr is non zero + (setf (uffi:deref-pointer out-len-ptr #.odbc::$ODBC-LONG-TYPE) #.odbc::$SQL_NO_TOTAL) (%bind-column hstmt col-nr c-type data-ptr (1+ size) out-len-ptr)) (vector-push-extend name column-names) (vector-push-extend sql-type column-sql-types) diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp index e46db57..9baec6a 100644 --- a/db-odbc/odbc-ff-interface.lisp +++ b/db-odbc/odbc-ff-interface.lisp @@ -61,7 +61,7 @@ (def-function "SQLDriverConnect" ((hdbc sql-handle) ; HDBC hdbc (hwnd sql-handle) ; SQLHWND hwnd - (*szConnStrIn string-ptr) ; UCHAR FAR *szConnStrIn + (*szConnStrIn :cstring) ; UCHAR FAR *szConnStrIn (cbConnStrIn :short) ; SWORD cbConnStrIn (*szConnStrOut string-ptr) ; UCHAR FAR *szConnStrOut (cbConnStrOutMax :short) ; SWORD cbConnStrOutMax diff --git a/db-odbc/odbc-package.lisp b/db-odbc/odbc-package.lisp index baedbed..011b6b4 100644 --- a/db-odbc/odbc-package.lisp +++ b/db-odbc/odbc-package.lisp @@ -39,6 +39,7 @@ #:%new-db-connection-handle #:%new-environment-handle #:%sql-connect + #:%sql-driver-connect #:disable-autocommit #:enable-autocommit #:%sql-free-environment diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 1f00008..e76b9d0 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -30,14 +30,14 @@ (defmethod database-name-from-spec (connection-spec (database-type (eql :odbc))) - (check-connection-spec connection-spec database-type (dsn user password)) - (destructuring-bind (dsn user password) connection-spec - (declare (ignore password)) + (check-connection-spec connection-spec database-type (dsn user password &key connection-string completion window-handle)) + (destructuring-bind (dsn user password &key connection-string completion window-handle) connection-spec + (declare (ignore password connection-string completion window-handle)) (concatenate 'string dsn "/" user))) (defmethod database-connect (connection-spec (database-type (eql :odbc))) - (check-connection-spec connection-spec database-type (dsn user password)) - (destructuring-bind (dsn user password) connection-spec + (check-connection-spec connection-spec database-type (dsn user password &key connection-string completion window-handle)) + (destructuring-bind (dsn user password &key connection-string (completion :no-prompt) window-handle) connection-spec (handler-case (let ((db (make-instance 'odbc-database :name (database-name-from-spec connection-spec :odbc) @@ -46,7 +46,10 @@ :odbc-conn (odbc-dbi:connect :user user :password password - :data-source-name dsn)))) + :data-source-name dsn + :connection-string connection-string + :completion completion + :window-handle window-handle)))) (store-type-of-connected-database db) ;; Ensure this database type is initialized so can check capabilities of ;; underlying database @@ -74,6 +77,9 @@ (unless (find-package 'clsql-postgresql) (ignore-errors (asdf:operate 'asdf:load-op 'clsql-postgresql-socket))) :postgresql) + ((or (search "Microsoft SQL Server" server-name :test #'char-equal) + (search "Microsoft SQL Server" dbms-name :test #'char-equal)) + :mssql) ((or (search "mysql" server-name :test #'char-equal) (search "mysql" dbms-name :test #'char-equal)) (unless (find-package 'clsql-mysql) @@ -127,7 +133,7 @@ ((null loop-rows) (nreverse results)) (let* ((row (car loop-rows)) (col (nth 5 row))) - (unless (find col results :test #'string-equal) + (unless (or (null col) (find col results :test #'string-equal)) (push col results)))))) ;;; Database capabilities diff --git a/debian/changelog b/debian/changelog index bb531ff..c671868 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +cl-sql (3.5.0-1) unstable; urgency=low + + * New upstream (closes: 339842) + * Change libmyclient run-time requirement (closes: 339824) + + -- Kevin M. Rosenberg Sat, 26 Nov 2005 08:58:22 -0700 + cl-sql (3.4.7-1) unstable; urgency=low * New upstream diff --git a/debian/control b/debian/control index 0140eaf..727fa1f 100644 --- a/debian/control +++ b/debian/control @@ -2,7 +2,7 @@ Source: cl-sql Section: devel Priority: extra Maintainer: Kevin M. Rosenberg -Build-Depends: debhelper (>= 4.0.0), libmysqlclient14-dev | libmysqlclient15-dev, libpq-dev +Build-Depends: debhelper (>= 4.0.0), libmysqlclient15-dev, libpq-dev Build-Depends-Indep: debhelper (>= 4.0.0) Standards-Version: 3.6.2.1 @@ -26,7 +26,7 @@ Description: Common UFFI functions for CLSQL database backends Package: cl-sql-mysql Architecture: any -Depends: cl-sql (>= ${Source-Version}), libmysqlclient14-dev | libmysqlclient15-dev, cl-sql-uffi (>= ${Source-Version}) +Depends: cl-sql (>= ${Source-Version}), libmysqlclient15, cl-sql-uffi (>= ${Source-Version}) Provides: cl-sql-backend Description: CLSQL database backend, MySQL This package enables you to use the CLSQL data access package diff --git a/doc/csql.xml b/doc/csql.xml index 272c625..f84dd50 100644 --- a/doc/csql.xml +++ b/doc/csql.xml @@ -250,7 +250,7 @@ mapped into a database). They would be defined as follows: - :column- - A string which will be used as the + :db-type - A string which will be used as the type specifier for this slots column definition in the database. diff --git a/sql/db-interface.lisp b/sql/db-interface.lisp index 0d67bb0..298214a 100644 --- a/sql/db-interface.lisp +++ b/sql/db-interface.lisp @@ -296,6 +296,12 @@ of TYPE_NAME (keyword) PRECISION SCALE NULLABLE.") nil) (:documentation "NIL [default] if database-type does not use column name on DROP INDEX.")) +(defgeneric db-type-use-fully-qualified-column-on-drop-index? (db-type) + (:method (db-type) + (declare (ignore db-type)) + nil) + (:documentation "NIL [default] if database-type does not require fully qualified column name on DROP INDEX.")) + (defgeneric db-type-has-views? (db-type) (:method (db-type) (declare (ignore db-type)) @@ -359,6 +365,17 @@ of TYPE_NAME (keyword) PRECISION SCALE NULLABLE.") nil) (:documentation "T if database backend supports prepared statements.")) +(defgeneric db-type-has-intersect? (db-type) + (:method (db-type) + (declare (ignore db-type)) + t) + (:documentation "T [default] if database-type supports INTERSECT.")) + +(defgeneric db-type-has-except? (db-type) + (:method (db-type) + (declare (ignore db-type)) + t) + (:documentation "T [default] if database-type supports EXCEPT.")) ;;; Large objects support (Marc Battyani) diff --git a/sql/fddl.lisp b/sql/fddl.lisp index 51f8f05..3b5b1bd 100644 --- a/sql/fddl.lisp +++ b/sql/fddl.lisp @@ -216,14 +216,14 @@ the index from." (unless (index-exists-p index-name :database database) (return-from drop-index))) (:error t)) - (unless (db-type-use-column-on-drop-index? - (database-underlying-type database)) - (setq on nil)) - (execute-command (format nil "DROP INDEX ~A~A" index-name - (if (null on) "" - (concatenate 'string " ON " - (database-identifier on database)))) - :database database))) + (let* ((db-type (database-underlying-type database)) + (index-identifier (cond ((db-type-use-fully-qualified-column-on-drop-index? db-type) + (format nil "~A.~A" (database-identifier on database) index-name)) + ((db-type-use-column-on-drop-index? db-type) + (format nil "~A ON ~A" index-name (database-identifier on database))) + (t index-name)))) + (execute-command (format nil "DROP INDEX ~A" index-identifier) + :database database)))) (defun list-indexes (&key (owner nil) (database *default-database*) (on nil)) "Returns a list of strings representing index names in DATABASE diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp index eb3430f..563e1f8 100644 --- a/sql/generic-odbc.lisp +++ b/sql/generic-odbc.lisp @@ -58,7 +58,68 @@ (db-type (eql :postgresql))) (if (string= "0" val) nil t)) - +(defmethod read-sql-value (val (type (eql 'boolean)) database + (db-type (eql :mssql))) + (declare (ignore database)) + (etypecase val + (string (if (string= "0" val) nil t)) + (integer (if (zerop val) nil t)))) + +(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database + (db-type (eql :mssql))) + (declare (ignore database)) + (etypecase val + (string (if (string= "0" val) nil t)) + (integer (if (zerop val) nil t)))) + +;;; Type methods + +(defmethod database-get-type-specifier ((type (eql 'wall-time)) args database + (db-type (eql :mssql))) + (declare (ignore args database)) + "DATETIME") + +(defmethod database-get-type-specifier ((type (eql 'boolean)) args database + (db-type (eql :mssql))) + (declare (ignore args database)) + "BIT") + +(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database + (db-type (eql :mssql))) + (declare (ignore args database)) + "BIT") + +;;; Generation of SQL strings from lisp expressions + +(defmethod database-output-sql ((tee (eql t)) (database generic-odbc-database)) + (case (database-underlying-type database) + (:mssql "1") + (t "'Y'"))) + +(defmethod database-output-sql-as-type ((type (eql 'boolean)) val database + (db-type (eql :mssql))) + (declare (ignore database)) + (if val 1 0)) + +(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database + (db-type (eql :mssql))) + (declare (ignore database)) + (if val 1 0)) + +;;; Database backend capabilities + +(defmethod db-type-use-fully-qualified-column-on-drop-index? ((db-type (eql :mssql))) + t) + +(defmethod db-type-has-boolean-where? ((db-type (eql :mssql))) + nil) + +(defmethod db-type-has-intersect? ((db-type (eql :mssql))) + nil) + +(defmethod db-type-has-except? ((db-type (eql :mssql))) + nil) + ;;; Backend methods (defmethod database-disconnect ((database generic-odbc-database)) @@ -66,8 +127,8 @@ (setf (odbc-conn database) nil) t) -(defmethod database-query (query-expression (database generic-odbc-database) - result-types field-names) +(defmethod database-query (query-expression (database generic-odbc-database) + result-types field-names) (handler-case (funcall (sql-fn database) query-expression :db (odbc-conn database) @@ -105,19 +166,19 @@ (defmethod database-query-result-set ((query-expression string) - (database generic-odbc-database) + (database generic-odbc-database) &key full-set result-types) - (handler-case + (handler-case (multiple-value-bind (query column-names) (funcall (sql-fn database) - query-expression - :db (odbc-conn database) + query-expression + :db (odbc-conn database) :row-count nil :column-names t :query t :result-types result-types) (values - (make-odbc-result-set :query query :full-set full-set + (make-odbc-result-set :query query :full-set full-set :types result-types) (length column-names) nil ;; not able to return number of rows with odbc @@ -156,7 +217,9 @@ ;; TABLE_NAME in third column, TABLE_TYPE in fourth column (loop for row in rows when (and (not (string-equal "information_schema" (nth 1 row))) - (string-equal "TABLE" (nth 3 row))) + (string-equal "TABLE" (nth 3 row)) + (not (and (eq :mssql (database-underlying-type database)) + (string-equal "dtproperties" (nth 2 row))))) collect (nth 2 row)))) @@ -170,7 +233,9 @@ ;; TABLE_NAME in third column, TABLE_TYPE in fourth column (loop for row in rows when (and (not (string-equal "information_schema" (nth 1 row))) - (string-equal "VIEW" (nth 3 row))) + (string-equal "VIEW" (nth 3 row)) + (not (and (eq :mssql (database-underlying-type database)) + (member (nth 2 row) '("sysconstraints" "syssegments") :test #'string-equal)))) collect (nth 2 row)))) diff --git a/sql/package.lisp b/sql/package.lisp index ad785ec..4c82b0a 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -150,6 +150,9 @@ #:db-type-has-fancy-math? #:db-type-default-case #:db-type-use-column-on-drop-index? + #:db-type-use-fully-qualified-column-on-drop-index? + #:db-type-has-intersect? + #:db-type-has-except? #:database-underlying-type #:database-get-type-specifier #:read-sql-value diff --git a/sql/time.lisp b/sql/time.lisp index 464d9cd..75f3faa 100644 --- a/sql/time.lisp +++ b/sql/time.lisp @@ -1274,7 +1274,7 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi (char= #\. (char string 19)))) (multiple-value-bind (parsed-usec usec-end) (parse-integer string :start 20 :junk-allowed t) - (setf usec parsed-usec + (setf usec (or parsed-usec 0) gmt-sec-offset (if (<= (+ 3 usec-end) strlen) (let ((skip-to (or (position #\+ string :start 19) (position #\- string :start 19)))) diff --git a/sql/transaction.lisp b/sql/transaction.lisp index 089ce0c..a9df87f 100644 --- a/sql/transaction.lisp +++ b/sql/transaction.lisp @@ -49,8 +49,10 @@ is called on DATABASE which defaults to *DEFAULT-DATABASE*." (setf (commit-hooks transaction) nil (rollback-hooks transaction) nil (transaction-status transaction) nil) - (unless (eq :oracle (database-underlying-type database)) - (execute-command "BEGIN" :database database))))) + (case (database-underlying-type database) + (:oracle nil) + (:mssql (execute-command "BEGIN TRANSACTION" :database database)) + (t (execute-command "BEGIN" :database database)))))) (defmethod database-commit-transaction ((database database)) (with-slots (transaction transaction-level autocommit) database diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index f5527c7..34c956a 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -88,9 +88,13 @@ '(:postgresql :postgresql-socket)) :ignore :warn))) - (clsql:create-table [foo] - '(([bar] integer :not-null :unique :primary-key) - ([baz] string :not-null :unique)))) + (case *test-database-underlying-type* + (:mssql (clsql:create-table [foo] + '(([bar] integer :not-null :primary-key) + ([baz] string :not-null :unique)))) + (t (clsql:create-table [foo] + '(([bar] integer :not-null :unique :primary-key) + ([baz] string :not-null :unique)))))) (clsql:table-exists-p [foo])) (progn (clsql:drop-table [foo]) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index aa88777..d2606c1 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -373,8 +373,11 @@ ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad")) (deftest :fdml/select/22 - (clsql:select [|| [first-name] " " [last-name]] :from [employee] - :flatp t :order-by [emplid] :field-names nil) + (case *test-database-underlying-type* + (:mssql (clsql:select [+ [first-name] " " [last-name]] :from [employee] + :flatp t :order-by [emplid] :field-names nil)) + (t (clsql:select [|| [first-name] " " [last-name]] :from [employee] + :flatp t :order-by [emplid] :field-names nil))) ("Vladimir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev" "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev" "Boris Yeltsin" "Vladimir Putin")) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index d775054..d745ff0 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -614,6 +614,15 @@ '(:postgresql :oracle))) (clsql-sys:in test :fddl/owner/1)) (push (cons test "table ownership not supported") skip-tests)) + ((and (null (clsql-sys:db-type-has-intersect? db-underlying-type)) + (clsql-sys:in test :fdml/query/7)) + (push (cons test "intersect not supported") skip-tests)) + ((and (null (clsql-sys:db-type-has-except? db-underlying-type)) + (clsql-sys:in test :fdml/query/8)) + (push (cons test "except not supported") skip-tests)) + ((and (eq *test-database-underlying-type* :mssql) + (clsql-sys:in test :fdml/select/9)) + (push (cons test "mssql uses integer math for AVG") skip-tests)) (t (push test-form test-forms))))) (values (nreverse test-forms) (nreverse skip-tests)))) -- 2.34.1