r9024: fix odbc on lww

[clsql.git] / db-odbc / odbc-api.lisp

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index 86505da017a5141e08e5b5c8959ff1e72f377d08..a15d628f8c3c82120ed7cbf7e91f00ba5f6465b2 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -31,6 +31,7 @@ May be locally bound to something else if a certain type is necessary.")
 as possible second argument) to the desired representation of date/time/timestamp.")
 
 (defvar +null-ptr+ (make-null-pointer :byte))
+(defparameter +null-handle-ptr+ (make-null-pointer :void))
 (defvar *info-output* nil
   "Stream to send SUCCESS_WITH_INFO messages.")
 
@@ -56,36 +57,36 @@ 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)
@@ -97,9 +98,9 @@ as possible second argument) to the desired representation of date/time/timestam
          (#.$SQL_SUCCESS_WITH_INFO
           (when ,print-info
             (multiple-value-bind (error-message sql-state)
-               (handle-error (or ,henv +null-ptr+)
-                             (or ,hdbc +null-ptr+)
-                             (or ,hstmt +null-ptr+))
+               (handle-error (or ,henv +null-handle-ptr+)
+                             (or ,hdbc +null-handle-ptr+)
+                             (or ,hstmt +null-handle-ptr+))
              (when *info-output*
                (format *info-output* "[ODBC info ~A] ~A state: ~A"
                        ,result-code error-message
@@ -115,9 +116,9 @@ as possible second argument) to the desired representation of date/time/timestam
           :odbc-message "Still executing"))
          (#.$SQL_ERROR
           (multiple-value-bind (error-message sql-state)
-             (handle-error (or ,henv +null-ptr+)
-                           (or ,hdbc +null-ptr+)
-                           (or ,hstmt +null-ptr+))
+             (handle-error (or ,henv +null-handle-ptr+)
+                           (or ,hdbc +null-handle-ptr+)
+                           (or ,hstmt +null-handle-ptr+))
             (error
             'clsql-base-sys:clsql-odbc-error
             :odbc-message error-message
@@ -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
@@ -831,7 +839,7 @@ as possible second argument) to the desired representation of date/time/timestam
                                       data-length)))
                     (error "wrong type. preliminary."))
                while (and (= res $SQL_SUCCESS_WITH_INFO)
-                          (equal (sql-state +null-ptr+ +null-ptr+ hstmt)
+                          (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)))
@@ -850,9 +858,9 @@ as possible second argument) to the desired representation of date/time/timestam
                     (error "wrong type. preliminary."))
                while 
                (and (= res $SQL_SUCCESS_WITH_INFO)
-                    #+ingore(eq (sql-state +null-ptr+ +null-ptr+ hstmt)
+                    #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)
                                 $sql-data-truncated)
-                    (equal (sql-state +null-ptr+ +null-ptr+ hstmt)
+                    (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)