r9020: more odbc improvements on sbcl/cmu

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index 86505da017a5141e08e5b5c8959ff1e72f377d08..38877a7c112ffadd254ea91d09f10b6c8fcbaf3e 100644 (file)
--- 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 cc0ca084dbf69c81e090d193ed76d0f8d8a5d29b..853d3fbca1fad267b7fa88ecec5fb773aefbf3ed 100644 (file)
--- 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 864436dac09712e4f612dd003505ad8ad14b2c4c..084a97fff4a51d488c795c953c0d469072bcc937 100644 (file)
--- 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 6248a73145cb3acd2d8c599f03f245e94dfc79bd..43bcfbb7b64b43453997f414b1b7a522e61dd554 100644 (file)
--- 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