r9329: * db-odbc/*.lisp: Add a layer of indirection to foreign-type

        of ODBC longs since this type can vary on 64-bit platforms depending
        upon the compilation options of unixODBC.

diff --git a/ChangeLog b/ChangeLog
index 8a0800530f8d355708ad70edbfd9898bb21703d6..4b7ffc52f7f529aaf844b19aab15c3eeae0a090d 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,7 @@
 11 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * db-odbc/*.lisp: Add a layer of indirection to foreign-type
+       of ODBC longs since this type can vary on 64-bit platforms depending
+       upon the compilation options of unixODBC.
        * db-mysql/mysql-api.lisp: Fix int vs. long slots in foreign
        structures found by testing with AllegroCL 7.0b AMD64.
        * db-*/*-loader.lisp: Load 64-bit libraries on 64-bit platorms

diff --git a/clsql-odbc.asd b/clsql-odbc.asd
index 6da2c6ef816d72c0c00f642463c48f4c8f10476b..3d3b1bbf85492a0c333a3cb47ce05d75eacebe38 100644 (file)
--- a/clsql-odbc.asd
+++ b/clsql-odbc.asd
@@ -35,7 +35,7 @@
            ((:file "odbc-package")
             (:file "odbc-loader" :depends-on ("odbc-package"))
             (:file "odbc-constants" :depends-on ("odbc-loader"))
-            (:file "odbc-ff-interface" :depends-on ("odbc-loader"))
+            (:file "odbc-ff-interface" :depends-on ("odbc-constants"))
             (:file "odbc-api" :depends-on ("odbc-ff-interface" "odbc-constants"))
             (:file "odbc-dbi" :depends-on ("odbc-api"))
             (:file "odbc-sql" :depends-on ("odbc-dbi"))))))

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index befda147934916cbcd33c783ee82f93f44635875..a320d7e3f561543d87314f5469b698de2de48dbe 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -63,7 +63,7 @@ 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)))
-    (with-foreign-objects ((error-code :long)
+    (with-foreign-objects ((error-code #.$ODBC-LONG-TYPE)
                           (msg-length :short))
       (SQLError henv hdbc hstmt sql-state
                error-code error-message
@@ -76,12 +76,12 @@ as possible second argument) to the desired representation of date/time/timestam
         err
         state
         (deref-pointer msg-length :short) 
-        (deref-pointer error-code :long))))))
+        (deref-pointer error-code #.$ODBC-LONG-TYPE))))))
 
 (defun sql-state (henv hdbc hstmt)
   (let ((sql-state (allocate-foreign-string 256))
        (error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
-    (with-foreign-objects ((error-code :long)
+    (with-foreign-objects ((error-code #.$ODBC-LONG-TYPE)
                           (msg-length :short))
       (SQLError henv hdbc hstmt sql-state error-code
                error-message #.$SQL_MAX_MESSAGE_LENGTH msg-length)
@@ -232,12 +232,16 @@ as possible second argument) to the desired representation of date/time/timestam
       (SQLFetch hstmt)))
 
 (defun %new-statement-handle (hdbc)
-  (with-foreign-object (hstmt-ptr 'sql-handle)
-    (with-error-handling 
-      (:hdbc hdbc)
-      (SQLAllocStmt hdbc hstmt-ptr) 
-      (deref-pointer hstmt-ptr 'sql-handle))))
-
+  (let ((statement-handle
+        (with-foreign-object (hstmt-ptr 'sql-handle)
+          (with-error-handling 
+              (:hdbc hdbc)
+            (SQLAllocStmt hdbc hstmt-ptr) 
+            (deref-pointer hstmt-ptr 'sql-handle)))))
+    (if (uffi:null-pointer-p statement-handle)
+       (error "Received null statement handle.")
+       statement-handle)))
+       
 (defun %sql-get-info (hdbc info-type)
   (ecase info-type
     ;; those return string
@@ -367,7 +371,7 @@ as possible second argument) to the desired representation of date/time/timestam
       #.$SQL_TIMEDATE_FUNCTIONS
       #.$SQL_TXN_ISOLATION_OPTION
       #.$SQL_UNION)
-     (with-foreign-objects ((info-ptr :long)
+     (with-foreign-objects ((info-ptr #.$ODBC-LONG-TYPE)
                            (info-length-ptr :short))
        (with-error-handling 
          (:hdbc hdbc)
@@ -376,7 +380,7 @@ as possible second argument) to the desired representation of date/time/timestam
                     info-ptr
                     255
                     info-length-ptr)
-         (deref-pointer info-ptr :long)))
+         (deref-pointer info-ptr #.$ODBC-LONG-TYPE)))
      )
     ;; those returning a long integer
     ((#.$SQL_DEFAULT_TXN_ISOLATION
@@ -390,12 +394,12 @@ as possible second argument) to the desired representation of date/time/timestam
       #.$SQL_MAX_CHAR_LITERAL_LEN
       #.$SQL_ACTIVE_ENVIRONMENTS
       )
-     (with-foreign-objects ((info-ptr :long)
+     (with-foreign-objects ((info-ptr #.$ODBC-LONG-TYPE)
                            (info-length-ptr :short))
        (with-error-handling 
          (:hdbc hdbc)
          (SQLGetInfo hdbc info-type info-ptr 255 info-length-ptr)
-         (deref-pointer info-ptr :long))))))
+         (deref-pointer info-ptr #.$ODBC-LONG-TYPE))))))
      
 (defun %sql-exec-direct (sql hstmt henv hdbc)
   (with-cstring (sql-ptr sql)
@@ -420,17 +424,17 @@ as possible second argument) to the desired representation of date/time/timestam
       (deref-pointer columns-nr-ptr :short))))
 
 (defun result-rows-count (hstmt)
-  (with-foreign-objects ((row-count-ptr :long))
+  (with-foreign-objects ((row-count-ptr #.$ODBC-LONG-TYPE))
     (with-error-handling (:hstmt hstmt)
                          (SQLRowCount hstmt row-count-ptr)
-      (deref-pointer row-count-ptr :long))))
+      (deref-pointer row-count-ptr #.$ODBC-LONG-TYPE))))
 
 ;; column counting is 1-based
 (defun %describe-column (hstmt column-nr)
   (let ((column-name-ptr (allocate-foreign-string 256)))
     (with-foreign-objects ((column-name-length-ptr :short)
                           (column-sql-type-ptr :short)
-                          (column-precision-ptr :unsigned-long)
+                          (column-precision-ptr #.$ODBC-ULONG-TYPE)
                           (column-scale-ptr :short)
                           (column-nullable-p-ptr :short))
       (with-error-handling (:hstmt hstmt)
@@ -445,14 +449,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 :unsigned-long)
+          (deref-pointer column-precision-ptr #.$ODBC-ULONG-TYPE)
           (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 :unsigned-long)
+                        (column-precision-ptr #.$ODBC-ULONG-TYPE)
                         (column-scale-ptr :short)
                         (column-nullable-p-ptr :short))
     (with-error-handling 
@@ -464,14 +468,14 @@ 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 :unsigned-long)
+       (deref-pointer column-precision-ptr #.$ODBC-ULONG-TYPE)
        (deref-pointer column-scale-ptr :short)
        (deref-pointer column-nullable-p-ptr :short)))))
 
 (defun %column-attributes (hstmt column-nr descriptor-type)
   (let ((descriptor-info-ptr (allocate-foreign-string 256)))
     (with-foreign-objects ((descriptor-length-ptr :short)
-                          (numeric-descriptor-ptr :long))
+                          (numeric-descriptor-ptr #.$ODBC-LONG-TYPE))
       (with-error-handling
          (:hstmt hstmt) 
          (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr
@@ -481,7 +485,7 @@ as possible second argument) to the desired representation of date/time/timestam
          (free-foreign-object descriptor-info-ptr)
          (values
           desc
-          (deref-pointer numeric-descriptor-ptr :long)))))))
+          (deref-pointer numeric-descriptor-ptr #.$ODBC-LONG-TYPE)))))))
   
 (defun %prepare-describe-columns (hstmt table-qualifier table-owner 
                                    table-name column-name)
@@ -556,7 +560,7 @@ as possible second argument) to the desired representation of date/time/timestam
 (def-type byte-pointer-type '(* :byte))
 (def-type short-pointer-type '(* :short))
 (def-type int-pointer-type '(* :int))
-(def-type long-pointer-type '(* :long))
+(def-type long-pointer-type '(* #.$ODBC-LONG-TYPE))
 (def-type float-pointer-type '(* :float))
 (def-type double-pointer-type '(* :double))
 (def-type string-pointer-type '(* :unsigned-char))
@@ -575,7 +579,7 @@ as possible second argument) to the desired representation of date/time/timestam
 
 (defun get-cast-long (ptr)
   (locally (declare (type long-pointer-type ptr))
-    (deref-pointer ptr :long)))
+    (deref-pointer ptr #.$ODBC-LONG-TYPE)))
 
 (defun get-cast-single-float (ptr)
   (locally (declare (type float-pointer-type ptr))
@@ -611,7 +615,7 @@ as possible second argument) to the desired representation of date/time/timestam
 
 (defun read-data (data-ptr c-type sql-type out-len-ptr result-type)
   (declare (type long-ptr-type out-len-ptr))
-  (let* ((out-len (deref-pointer out-len-ptr :long))
+  (let* ((out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))
         (value
          (cond ((= out-len $SQL_NULL_DATA)
                 *null*)
@@ -685,7 +689,7 @@ as possible second argument) to the desired representation of date/time/timestam
          (long-p (= size +max-precision+))
          (data-ptr
           (case c-type ;; add more?
-            (#.$SQL_C_SLONG (uffi:allocate-foreign-object :long))
+            (#.$SQL_C_SLONG (uffi:allocate-foreign-object #.$ODBC-LONG-TYPE))
             (#.$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))
@@ -702,7 +706,7 @@ as possible second argument) to the desired representation of date/time/timestam
                   (break "SQL type is ~A, precision ~D, size ~D, C type is ~A" 
                          sql-type precision size c-type))
                 (uffi:allocate-foreign-object :byte (1+ size)))))
-         (out-len-ptr (uffi:allocate-foreign-object :long)))
+         (out-len-ptr (uffi:allocate-foreign-object #.$ODBC-LONG-TYPE)))
     (values c-type data-ptr out-len-ptr size long-p)))
 
 (defun fetch-all-rows (hstmt &key free-option flatp)
@@ -776,10 +780,10 @@ 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-object (param-ptr :long)
+  (with-foreign-object (param-ptr #.$ODBC-LONG-TYPE)
     (with-error-handling (:hdbc hdbc)
                          (SQLGetConnectOption hdbc option param-ptr)
-      (deref-pointer param-ptr :long))))
+      (deref-pointer param-ptr #.$ODBC-LONG-TYPE))))
 
 (defun set-connection-option (hdbc option param)
   (with-error-handling (:hdbc hdbc)
@@ -797,12 +801,12 @@ as possible second argument) to the desired representation of date/time/timestam
     (SQLSetPos hstmt row option lock)))
 
 (defun %sql-extended-fetch (hstmt fetch-type row)
-  (with-foreign-objects ((row-count-ptr :unsigned-long)
+  (with-foreign-objects ((row-count-ptr #.$ODBC-ULONG-TYPE)
                         (row-status-ptr :short))
     (with-error-handling (:hstmt hstmt)
       (SQLExtendedFetch hstmt fetch-type row row-count-ptr
                        row-status-ptr)
-      (values (deref-pointer row-count-ptr :unsigned-long)
+      (values (deref-pointer row-count-ptr #.$ODBC-ULONG-TYPE)
               (deref-pointer row-status-ptr :short)))))
 
 ; column-nr is zero-based
@@ -828,7 +832,7 @@ as possible second argument) to the desired representation of date/time/timestam
   (declare (type long-ptr-type out-len-ptr))
   (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr 
                              +max-precision+ out-len-ptr))
-         (out-len (deref-pointer out-len-ptr :long))
+         (out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE))
          (offset 0))
     (case out-len
       (#.$SQL_NULL_DATA
@@ -870,7 +874,7 @@ as possible second argument) to the desired representation of date/time/timestam
                            "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 :long)))
+                        out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
          (if (= sql-type $SQL_DECIMAL)
              (let ((*read-base* 10))
                (read-from-string str))

diff --git a/db-odbc/odbc-constants.lisp b/db-odbc/odbc-constants.lisp
index cddb4be8288d1377c6a8d375440cabb108185ca5..5ca1f2ac860114cd66378a702bff6edffa38ebae 100644 (file)
--- a/db-odbc/odbc-constants.lisp
+++ b/db-odbc/odbc-constants.lisp
@@ -18,6 +18,10 @@
 
 (in-package #:odbc)
 
+;; on SuSE AMD64 9.0, unixODBC is compiled with with SQLLEN being 4 bytes long
+(defconstant $ODBC-LONG-TYPE :int)
+(defconstant $ODBC-ULONG-TYPE :unsigned-int)
+
 (defconstant $ODBCVER  #x0210)
 
 ;; generally useful constants

diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp
index 0de8eddf4bd7bd58f27f845b664aeb6e9abbfea0..7b20556f0946de50d9b0e43ad940a0be2b796cd7 100644 (file)
--- a/db-odbc/odbc-dbi.lisp
+++ b/db-odbc/odbc-dbi.lisp
@@ -554,10 +554,10 @@ This makes the functions db-execute-command and db-query thread safe."
   (ecase sql-type
     ((#.odbc::$SQL_CHAR #.odbc::$SQL_VARCHAR #.odbc::$SQL_LONGVARCHAR) :string)
     ((#.odbc::$SQL_NUMERIC #.odbc::$SQL_DECIMAL #.odbc::$SQL_BIGINT) :string) ; ??
-    (#.odbc::$SQL_INTEGER :long)
+    (#.odbc::$SQL_INTEGER #.odbc::$ODBC-LONG-TYPE)
     (#.odbc::$SQL_SMALLINT :short)
-    ((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) :long)
-    (#.odbc::$SQL_REAL :long)
+    ((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) #.odbc::$ODBC-LONG-TYPE)
+    (#.odbc::$SQL_REAL #.odbc::$ODBC-LONG-TYPE)
     (#.odbc::$SQL_DATE 'sql-c-date)
     (#.odbc::$SQL_TIME 'sql-c-time)
     (#.odbc::$SQL_TIMESTAMP 'sql-c-timestamp)

diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp
index 4ab8627df91e4ef3a9d5eadde7d1537faa376087..6df89376f55fb384164b157c7a9eaccfeb5088d7 100644 (file)
--- a/db-odbc/odbc-ff-interface.lisp
+++ b/db-odbc/odbc-ff-interface.lisp
@@ -21,7 +21,7 @@
 (def-foreign-type sql-handle :pointer-void)
 (def-foreign-type sql-handle-ptr '(* sql-handle))
 (def-foreign-type string-ptr '(* :unsigned-char))
-(def-type long-ptr-type '(* :int))
+(def-type long-ptr-type '(* #.$ODBC-LONG-TYPE))
 
 
 (def-function "SQLAllocEnv"

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 9cf50ff6b2508d47dc58e1942f8d522c835d5cd7..f0ff688bfa8537c8f40db699d83f572c0db0be6f 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -551,16 +551,18 @@
       (values (nreverse test-forms) (nreverse skip-tests))))
 
 
-(defun rl ()
+(defun rapid-load (type)
   "Rapid load for interactive testing."
   (when *default-database*
       (disconnect :database *default-database*))
-  (test-connect-to-database :postgresql (car (postgresql-spec (read-specs))))
+  (test-connect-to-database type (car (db-type-spec type (read-specs))))
   (test-initialise-database))
 
+(defun rl ()
+  (rapid-load :postgresql))
+
 (defun rlm ()
-  "Rapid load for interactive testing."
-  (when *default-database*
-      (disconnect :database *default-database*))
-  (test-connect-to-database :mysql (car (mysql-spec (read-specs))))
-  (test-initialise-database))
+  (rapid-load :mysql))
+
+(defun rlo ()
+  (rapid-load :odbc))