From: Kevin M. Rosenberg Date: Thu, 15 Apr 2004 15:59:19 +0000 (+0000) Subject: r9019: odbc updates X-Git-Tag: v3.8.6~625 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=6e8ef7161f2d2759bf8d78740e7e93bea5eca781 r9019: odbc updates --- diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 915de7e..86505da 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -34,9 +34,6 @@ as possible second argument) to the desired representation of date/time/timestam (defvar *info-output* nil "Stream to send SUCCESS_WITH_INFO messages.") -(defun %null-ptr () - (make-null-pointer :byte)) - (defmacro %put-str (ptr string &optional max-length) (let ((size (gensym))) `(let ((,size (length ,string))) @@ -534,8 +531,8 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_INTEGER $SQL_C_SLONG) (#.$SQL_SMALLINT $SQL_C_SSHORT) (#.$SQL_DOUBLE $SQL_C_DOUBLE) - (#.$SQL_FLOAT $SQL_C_FLOAT) - (#.$SQL_REAL $SQL_C_DOUBLE) + (#.$SQL_FLOAT $SQL_C_DOUBLE) + (#.$SQL_REAL $SQL_C_FLOAT) (#.$SQL_DATE $SQL_C_DATE) (#.$SQL_TIME $SQL_C_TIME) (#.$SQL_TIMESTAMP $SQL_C_TIMESTAMP) @@ -615,8 +612,7 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_INTEGER (get-cast-int data-ptr)) (#.$SQL_BIGINT (read-from-string (get-cast-foreign-string data-ptr))) - (#.$SQL_TINYINT (read-from-string - (get-cast-foreign-string data-ptr))) + (#.$SQL_TINYINT (get-cast-byte data-ptr)) (#.$SQL_DECIMAL (let ((*read-base* 10)) (read-from-string (get-cast-foreign-string data-ptr)))) @@ -676,14 +672,13 @@ as possible second argument) to the desired representation of date/time/timestam (data-ptr (case c-type ;; add more? (#.$SQL_C_SLONG (uffi:allocate-foreign-object :long)) - (#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double)) (#.$SQL_C_DATE (allocate-foreign-object 'sql-c-date)) (#.$SQL_C_TIME (allocate-foreign-object 'sql-c-time)) (#.$SQL_C_TIMESTAMP (allocate-foreign-object 'sql-c-timestamp)) (#.$SQL_C_FLOAT (uffi:allocate-foreign-object :float)) - (#.$SQL_REAL (uffi:allocate-foreign-object :float)) + (#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double)) (#.$SQL_C_BIT (uffi:allocate-foreign-object :byte)) - (#.$SQL_C_STINYINT (uffi:allocate-foreign-object :byte)) + (#.$SQL_C_STINYINT (uffi:allocate-foreign-object :short)) (#.$SQL_C_SSHORT (uffi:allocate-foreign-object :short)) (#.$SQL_C_CHAR (uffi:allocate-foreign-string (1+ size))) (#.$SQL_C_BINARY (uffi:allocate-foreign-string (1+ (* 2 size)))) @@ -692,7 +687,7 @@ as possible second argument) to the desired representation of date/time/timestam (when *break-on-unknown-data-type* (break "SQL type is ~A, precision ~D, size ~D, C type is ~A" sql-type precision size c-type)) - (uffi:allocate-foreign-object :pointer-void (1+ size))))) + (uffi:allocate-foreign-object :byte (1+ size))))) (out-len-ptr (uffi:allocate-foreign-object :long))) (values c-type data-ptr out-len-ptr size long-p))) @@ -767,7 +762,7 @@ as possible second argument) to the desired representation of date/time/timestam ;; depending on option, we return a long int or a string; string not implemented (defun get-connection-option (hdbc option) - (with-foreign-objects ((param-ptr :long)) + (with-foreign-object (param-ptr :long) (with-error-handling (:hdbc hdbc) (SQLGetConnectOption hdbc option param-ptr) (deref-pointer param-ptr :long)))) @@ -868,6 +863,8 @@ as possible second argument) to the desired representation of date/time/timestam str)))))) (def-type c-timestamp-ptr-type '(* (:struct sql-c-timestamp))) +(def-type c-time-ptr-type '(* (:struct sql-c-time))) +(def-type c-date-ptr-type '(* (:struct sql-c-date))) (defun timestamp-to-universal-time (ptr) (declare (type c-timestamp-ptr-type ptr)) @@ -884,7 +881,7 @@ as possible second argument) to the desired representation of date/time/timestam (defun universal-time-to-timestamp (time &optional (fraction 0)) (multiple-value-bind (sec min hour day month year) (decode-universal-time time) - (with-foreign-object (ptr 'sql-c-timestamp) + (let ((ptr (allocate-foreign-object 'sql-c-timestamp))) (setf (get-slot-value ptr 'sql-c-timestamp 'second) sec (get-slot-value ptr 'sql-c-timestamp 'minute) min (get-slot-value ptr 'sql-c-timestamp 'hour) hour @@ -908,7 +905,7 @@ as possible second argument) to the desired representation of date/time/timestam ptr)) (defun date-to-universal-time (ptr) - (declare (type c-timestamp-ptr-type ptr)) + (declare (type c-date-ptr-type ptr)) (encode-universal-time 0 0 0 (get-slot-value ptr 'sql-c-timestamp 'day) @@ -916,7 +913,7 @@ as possible second argument) to the desired representation of date/time/timestam (get-slot-value ptr 'sql-c-timestamp 'year))) (defun time-to-universal-time (ptr) - (declare (type c-timestamp-type ptr)) + (declare (type c-time-ptr-type ptr)) (encode-universal-time (get-slot-value ptr 'sql-c-timestamp 'second) (get-slot-value ptr 'sql-c-timestamp 'minute) diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index 08a8df6..cc0ca08 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -110,7 +110,7 @@ the query against." )) (setf (henv db) (%new-environment-handle))) (setf (hdbc db) (%new-db-connection-handle (henv db))) (%sql-connect (hdbc db) data-source-name user password) - (setf (db-hstmt db) (%new-statement-handle (hdbc db))) + #+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 (enable-autocommit (hdbc db)) @@ -125,7 +125,8 @@ the query against." )) (when hstmt (%free-statement hstmt :drop) (setf hstmt nil))))) - (%free-statement (db-hstmt database) :drop) + (when (db-hstmt database) + (%free-statement (db-hstmt database) :drop)) (%disconnect hdbc))) @@ -314,14 +315,14 @@ the query against." )) (defmethod get-free-query ((database odbc-db)) "get-free-query finds or makes a nonactive query object, and then sets it to active. This makes the functions db-execute-command and db-query thread safe." - (with-slots (queries) database + (with-slots (queries hdbc) database (or (clsql-base-sys:without-interrupts (let ((inactive-query (find-if (lambda (query) (not (query-active-p query))) queries))) (when inactive-query (with-slots (column-count column-names column-c-types - width + width hstmt column-sql-types column-data-ptrs column-out-len-ptrs column-precisions column-scales column-nullables-p) @@ -330,6 +331,7 @@ This makes the functions db-execute-command and db-query thread safe." ;;(%dispose-column-ptrs inactive-query) (setf column-count 0 width +max-precision+ + hstmt (%new-statement-handle hdbc) (fill-pointer column-names) 0 (fill-pointer column-c-types) 0 (fill-pointer column-sql-types) 0 diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp index 6dd6997..864436d 100644 --- a/db-odbc/odbc-ff-interface.lisp +++ b/db-odbc/odbc-ff-interface.lisp @@ -334,18 +334,17 @@ (def-struct sql-c-date (year :short) - (month :short) - (day :short)) + (month :short) + (day :short)) (def-struct sql-c-timestamp (year :short) - (month :short) - (day :short) - (hour :short) - (minute :short) - (second :short) - (fraction :long)) - + (month :short) + (day :short) + (hour :short) + (minute :short) + (second :short) + (fraction :long)) ;;; Added by KMR diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 1d39272..6248a73 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -103,6 +103,7 @@ (odbc-dbi:sql sql-expression :db (database-odbc-conn database)) (clsql-error (e) (error e)) + #+ignore (error () (error 'clsql-sql-error :database database diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index 556deb8..e57ee28 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -84,7 +84,7 @@ (clsql:execute-command "DROP TABLE test_clsql" :database db)) (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" + "CREATE TABLE test_clsql (t_int integer, t_float double, t_bigint BIGINT, t_str CHAR(30))" :database db) (dotimes (i 11) (let* ((test-int (- i 5)) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 4fe9c2e..964849c 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -321,7 +321,6 @@ (ignore-errors (destroy-database spec :database-type db-type)) (ignore-errors (create-database spec :database-type db-type)) - ;; Also manually delete the tables since destroy-database/create-database doesn't work on ODBC (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml* *rt-ooddl* *rt-oodml* *rt-syntax*))