From a6576bcf62dd1e710085ec74089d0730d599001b Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 12 May 2004 21:58:26 +0000 Subject: [PATCH] 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. --- ChangeLog | 3 ++ clsql-odbc.asd | 2 +- db-odbc/odbc-api.lisp | 68 ++++++++++++++++++---------------- db-odbc/odbc-constants.lisp | 4 ++ db-odbc/odbc-dbi.lisp | 6 +-- db-odbc/odbc-ff-interface.lisp | 2 +- tests/test-init.lisp | 16 ++++---- 7 files changed, 57 insertions(+), 44 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8a08005..4b7ffc5 100644 --- 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 6da2c6e..3d3b1bb 100644 --- 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 befda14..a320d7e 100644 --- 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 cddb4be..5ca1f2a 100644 --- 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 0de8edd..7b20556 100644 --- 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 4ab8627..6df8937 100644 --- 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 9cf50ff..f0ff688 100644 --- 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)) -- 2.34.1