From a3974aaf6e6e53354b712bfe5db3b5b5db49c010 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 15 Apr 2004 18:30:05 +0000 Subject: [PATCH] r9020: more odbc improvements on sbcl/cmu --- db-odbc/odbc-api.lisp | 88 ++++++++++++++++++---------------- db-odbc/odbc-dbi.lisp | 2 +- db-odbc/odbc-ff-interface.lisp | 34 ++++++------- db-odbc/odbc-sql.lisp | 2 + 4 files changed, 68 insertions(+), 58 deletions(-) diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 86505da..38877a7 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -56,36 +56,37 @@ as possible second argument) to the desired representation of date/time/timestam (defun handle-error (henv hdbc hstmt) (let ((sql-state (allocate-foreign-string 256)) - (error-message (allocate-foreign-string $SQL_MAX_MESSAGE_LENGTH))) + (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH))) (with-foreign-objects ((error-code :long) (msg-length :short)) (SQLError henv hdbc hstmt sql-state error-code error-message - $SQL_MAX_MESSAGE_LENGTH msg-length) - (values - (prog1 - (convert-from-foreign-string error-message) - (free-foreign-object error-message)) - (prog1 - (convert-from-foreign-string sql-state) - (free-foreign-object error-message)) - (deref-pointer msg-length :short) - (deref-pointer error-code :long))))) + #.$SQL_MAX_MESSAGE_LENGTH msg-length) + (let ((err (convert-from-foreign-string error-message)) + (state (convert-from-foreign-string sql-state))) + + (free-foreign-object error-message) + (free-foreign-object sql-state) + (values + err + state + (deref-pointer msg-length :short) + (deref-pointer error-code :long)))))) (defun sql-state (henv hdbc hstmt) (let ((sql-state (allocate-foreign-string 256)) - (error-message (allocate-foreign-string $SQL_MAX_MESSAGE_LENGTH))) + (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH))) (with-foreign-objects ((error-code :long) (msg-length :short)) (SQLError henv hdbc hstmt sql-state error-code - error-message $SQL_MAX_MESSAGE_LENGTH msg-length) - (free-foreign-object error-message) - (prog1 - (convert-from-foreign-string sql-state) - (free-foreign-object sql-state))) - ;; test this: return a keyword for efficiency - ;;(%cstring-to-keyword sql-state) - )) + error-message #.$SQL_MAX_MESSAGE_LENGTH msg-length) + (let ((state (convert-from-foreign-string sql-state))) + (free-foreign-object error-message) + (free-foreign-object sql-state) + state + ;; test this: return a keyword for efficiency + ;;(%cstring-to-keyword state) + )))) (defmacro with-error-handling ((&key henv hdbc hstmt (print-info t)) odbc-call &body body) @@ -273,9 +274,9 @@ as possible second argument) to the desired representation of date/time/timestam (with-error-handling (:hdbc hdbc) (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr) - (prog1 - (convert-from-foreign-string info-ptr) - (free-foreign-object info-ptr)))))) + (let ((info (convert-from-foreign-string info-ptr))) + (free-foreign-object info-ptr) + info))))) ;; those returning a word ((#.$SQL_ACTIVE_CONNECTIONS #.$SQL_ACTIVE_STATEMENTS @@ -424,7 +425,7 @@ as possible second argument) to the desired representation of date/time/timestam (let ((column-name-ptr (allocate-foreign-string 256))) (with-foreign-objects ((column-name-length-ptr :short) (column-sql-type-ptr :short) - (column-precision-ptr :long) + (column-precision-ptr :unsigned-long) (column-scale-ptr :short) (column-nullable-p-ptr :short)) (with-error-handling (:hstmt hstmt) @@ -439,14 +440,14 @@ as possible second argument) to the desired representation of date/time/timestam (values column-name (deref-pointer column-sql-type-ptr :short) - (deref-pointer column-precision-ptr :long) + (deref-pointer column-precision-ptr :unsigned-long) (deref-pointer column-scale-ptr :short) (deref-pointer column-nullable-p-ptr :short))))))) ;; parameter counting is 1-based (defun %describe-parameter (hstmt parameter-nr) (with-foreign-objects ((column-sql-type-ptr :short) - (column-precision-ptr :long) + (column-precision-ptr :unsigned-long) (column-scale-ptr :short) (column-nullable-p-ptr :short)) (with-error-handling @@ -458,7 +459,7 @@ as possible second argument) to the desired representation of date/time/timestam column-nullable-p-ptr) (values (deref-pointer column-sql-type-ptr :short) - (deref-pointer column-precision-ptr :long) + (deref-pointer column-precision-ptr :unsigned-long) (deref-pointer column-scale-ptr :short) (deref-pointer column-nullable-p-ptr :short))))) @@ -471,11 +472,11 @@ as possible second argument) to the desired representation of date/time/timestam (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr 256 descriptor-length-ptr numeric-descriptor-ptr) - (values - (prog1 - (convert-from-foreign-string descriptor-info-ptr) - (free-foreign-object descriptor-info-ptr)) - (deref-pointer numeric-descriptor-ptr :long)))))) + (let ((desc (convert-from-foreign-string descriptor-info-ptr))) + (free-foreign-object descriptor-info-ptr) + (values + desc + (deref-pointer numeric-descriptor-ptr :long))))))) (defun %prepare-describe-columns (hstmt table-qualifier table-owner table-name column-name) @@ -515,14 +516,21 @@ as possible second argument) to the desired representation of date/time/timestam description-ptr 1024 description-length-ptr)))) - (unless (= res $SQL_NO_DATA_FOUND) - (values - (prog1 - (convert-from-foreign-string name-ptr) - (free-foreign-object name-ptr)) - (prog1 - (convert-from-foreign-string description-ptr) - (free-foreign-object description-ptr)))))))) + (cond + ((= res $SQL_NO_DATA_FOUND) + (let ((name (convert-from-foreign-string name-ptr)) + (desc (convert-from-foreign-string description-ptr))) + (free-foreign-object name-ptr) + (free-foreign-object description-ptr) + (values + name + desc))) + (t + (free-foreign-object name-ptr) + (free-foreign-object description-ptr) + nil)))))) + + (defun sql-to-c-type (sql-type) (ecase sql-type diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index cc0ca08..853d3fb 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -331,7 +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) + ;; KMR 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 864436d..084a97f 100644 --- a/db-odbc/odbc-ff-interface.lisp +++ b/db-odbc/odbc-ff-interface.lisp @@ -123,24 +123,24 @@ (hdbc sql-handle) ; HDBC hdbc (hstmt sql-handle) ; HSTMT hstmt (*szSqlState string-ptr) ; UCHAR FAR *szSqlState - (*pfNativeError :pointer-void) ; SDWORD FAR *pfNativeError + (*pfNativeError (* :long)) ; SDWORD FAR *pfNativeError (*szErrorMsg string-ptr) ; UCHAR FAR *szErrorMsg (cbErrorMsgMax :short) ; SWORD cbErrorMsgMax - (*pcbErrorMsg :pointer-void) ; SWORD FAR *pcbErrorMsg + (*pcbErrorMsg (* :short)) ; SWORD FAR *pcbErrorMsg ) :module "odbc" :returning :short) ; RETCODE_SQL_API (def-function "SQLNumResultCols" ((hstmt sql-handle) ; HSTMT hstmt - (*pccol :pointer-void) ; SWORD FAR *pccol + (*pccol (* :short)) ; SWORD FAR *pccol ) :module "odbc" :returning :short) ; RETCODE_SQL_API (def-function "SQLRowCount" ((hstmt sql-handle) ; HSTMT hstmt - (*pcrow :pointer-void) ; SDWORD FAR *pcrow + (*pcrow (* :long)) ; SDWORD FAR *pcrow ) :module "odbc" :returning :short) ; RETCODE_SQL_API @@ -150,11 +150,11 @@ (icol :short) ; UWORD icol (*szColName string-ptr) ; UCHAR FAR *szColName (cbColNameMax :short) ; SWORD cbColNameMax - (*pcbColName :pointer-void) ; SWORD FAR *pcbColName - (*pfSqlType :pointer-void) ; SWORD FAR *pfSqlType - (*pcbColDef :pointer-void) ; UDWORD FAR *pcbColDef - (*pibScale :pointer-void) ; SWORD FAR *pibScale - (*pfNullable :pointer-void) ; SWORD FAR *pfNullable + (*pcbColName (* :short)) ; SWORD FAR *pcbColName + (*pfSqlType (* :short)) ; SWORD FAR *pfSqlType + (*pcbColDef (* :unsigned-long)) ; UDWORD FAR *pcbColDef + (*pibScale (* :short)) ; SWORD FAR *pibScale + (*pfNullable (* :short)) ; SWORD FAR *pfNullable ) :module "odbc" :returning :short) ; RETCODE_SQL_API @@ -163,10 +163,10 @@ ((hstmt sql-handle) ; HSTMT hstmt (icol :short) ; UWORD icol (fDescType :short) ; UWORD fDescType - (rgbDesc :cstring) ; PTR rgbDesc + (rgbDesc string-ptr) ; PTR rgbDesc (cbDescMax :short) ; SWORD cbDescMax - (*pcbDesc :cstring) ; SWORD FAR *pcbDesc - (*pfDesc :pointer-void) ; SDWORD FAR *pfDesc + (*pcbDesc (* :short)) ; SWORD FAR *pcbDesc + (*pfDesc (* :long)) ; SDWORD FAR *pfDesc ) :module "odbc" :returning :short) ; RETCODE_SQL_API @@ -191,7 +191,7 @@ (fCType :short) ; SWORD fCType (rgbValue :pointer-void) ; PTR rgbValue (cbValueMax :long) ; SDWORD cbValueMax - (*pcbValue :pointer-void) ; SDWORD FAR *pcbValue + (*pcbValue (* :long)) ; SDWORD FAR *pcbValue ) :module "odbc" :returning :short) ; RETCODE_SQL_API @@ -214,10 +214,10 @@ (def-function "SQLDescribeParam" ((hstmt sql-handle) ; HSTMT hstmt (ipar :short) ; UWORD ipar - (*pfSqlType :pointer-void) ; SWORD FAR *pfSqlType - (*pcbColDef :pointer-void) ; UDWORD FAR *pcbColDef - (*pibScale :pointer-void) ; SWORD FAR *pibScale - (*pfNullable :pointer-void) ; SWORD FAR *pfNullable + (*pfSqlType (* :short)) ; SWORD FAR *pfSqlType + (*pcbColDef (* :unsigned-long)) ; UDWORD FAR *pcbColDef + (*pibScale (* :short)) ; SWORD FAR *pibScale + (*pfNullable (* :short)) ; SWORD FAR *pfNullable ) :module "odbc" :returning :short) ; RETCODE_SQL_API diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 6248a73..43bcfbb 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -52,6 +52,7 @@ db) (clsql-error (e) (error e)) + #+ignore (error () ;; Init or Connect failed (error 'clsql-connect-error :database-type database-type @@ -133,6 +134,7 @@ (length column-names) nil ;; not able to return number of rows with odbc )) + #+ignore (error () (error 'clsql-sql-error :database database -- 2.34.1