Index: vendor/src/test/test-postgresql.lisp =================================================================== --- vendor/src/test/test-postgresql.lisp (revision vendor,8) +++ vendor/src/test/test-postgresql.lisp (revision vendor,8) @@ -0,0 +1,14 @@ +;;; -*- Mode: lisp -*- + +(in-package :test-plain-odbc) + +(export '(run-postgresql-tests)) + +(defun run-postgresql-tests (conn) + (dolist (sym '(pg-test-connection)) + (pprint sym) + (funcall sym conn))) + +(defun pg-test-connection (conn) + (let ((n (caar (exec-query conn "SELECT 1")))) + (assert (= 1 n)))) Index: vendor/src/odbc/column.lisp =================================================================== --- vendor/src/odbc/column.lisp (revision vendor,3) +++ vendor/src/odbc/column.lisp (revision vendor,8) Index: vendor/src/odbc/ffi-support.lisp =================================================================== --- vendor/src/odbc/ffi-support.lisp (revision vendor,5) +++ vendor/src/odbc/ffi-support.lisp (revision vendor,8) @@ -4,16 +4,43 @@ -(defun get-string (ptr length) - (cffi:foreign-string-to-lisp ptr length nil) - ) +(defmacro cffi-0.10-or-0.9 (form-0.10 form-0.9) + (if (BOUNDP 'cffi::*foreign-string-mappings*) + form-0.10 + form-0.9)) -(defun get-string-nts (ptr) - (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM t)) +(cffi-0.10-or-0.9 + (defun get-string (ptr length) + (cffi:foreign-string-to-lisp ptr :count length :encoding :iso-8859-1) + ) + (defun get-string (ptr length) + (cffi:foreign-string-to-lisp ptr length nil) + ) + ) + +(cffi-0.10-or-0.9 + (defun get-string-nts (ptr) + (cffi:foreign-string-to-lisp ptr :max-chars MOST-POSITIVE-FIXNUM :encoding :iso-8859-1)) + (defun get-string-nts (ptr) + (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM t))) -(defun put-string (ptr vector) - (cffi:lisp-string-to-foreign vector ptr (1+ (length vector)))) +(cffi-0.10-or-0.9 + (defun put-string (ptr vector) + (cffi:lisp-string-to-foreign vector ptr (1+ (length vector)) :encoding :iso-8859-1)) + (defun put-string (ptr vector) + (cffi:lisp-string-to-foreign vector ptr (1+ (length vector))))) (defun %null-ptr () (cffi:null-pointer)) + + +(cffi-0.10-or-0.9 + (defmacro with-foreign-string-alloc ((ptr text) &body body) + `(cffi:with-foreign-string (,ptr ,text :encoding :iso-8859-1) + ,@body)) + + (defmacro with-foreign-string-alloc ((ptr text) &body body) + `(cffi:with-foreign-string (,ptr ,text) + ,@body))) + (defun get-byte-vector (ptr length) Index: vendor/src/odbc/odbc-functions.lisp =================================================================== --- vendor/src/odbc/odbc-functions.lisp (revision vendor,5) +++ vendor/src/odbc/odbc-functions.lisp (revision vendor,8) @@ -97,9 +97,14 @@ (#.$SQL_INVALID_HANDLE (values result-code - (make-condition 'sql-error :error-message "[ODBC error] Invalid handle"))) + (make-condition 'sql-error :error-message "[ODBC error] Invalid handle" + :sql-state nil + :error-code nil + ))) ;; maybe this should raise an error immediately (#.$SQL_STILL_EXECUTING (values result-code - (make-condition 'sql-error :error-message"[ODBC error] Still executing"))) + (make-condition 'sql-error :error-message"[ODBC error] Still executing" + :sql-state nil + :error-code nil))) (#.$SQL_NEED_DATA (values result-code nil)) @@ -167,5 +172,5 @@ (:prompt $SQL_DRIVER_PROMPT) (:noprompt $SQL_DRIVER_NOPROMPT)))) - (cffi:with-foreign-string (connection-str-ptr connection-string) + (with-foreign-string-alloc (connection-str-ptr connection-string) (with-temporary-allocations ((complete-connection-str-ptr (alloc-chars 1024)) @@ -414,5 +419,5 @@ (defun %sql-exec-direct (sql hstmt henv hdbc) (declare (string sql)) - (cffi:with-foreign-string (sql-ptr sql) + (with-foreign-string-alloc (sql-ptr sql) (with-error-handling (:hstmt hstmt :henv henv :hdbc hdbc) @@ -498,5 +503,5 @@ (defun %sql-prepare (hstmt sql) (declare (string sql)) - (cffi:with-foreign-string (sql-ptr sql) + (with-foreign-string-alloc (sql-ptr sql) (with-error-handling (:hstmt hstmt) (SQLPrepare hstmt sql-ptr $SQL_NTS)))) @@ -523,5 +528,5 @@ (defun set-connection-attr-string (hdbc option val) (with-error-handling (:hdbc hdbc) - (cffi:with-foreign-string (ptr val) + (with-foreign-string-alloc (ptr val) ;; TODO: Null-terminator with length? (SQLSetConnectAttr_string hdbc option ptr (length val))))) Index: vendor/src/odbc/odbc-main.lisp =================================================================== --- vendor/src/odbc/odbc-main.lisp (revision vendor,6) +++ vendor/src/odbc/odbc-main.lisp (revision vendor,8) @@ -204,18 +204,17 @@ (nreverse res))) -(defun bind-columns (query) +(defun bind-columns (query columncount) (with-slots (hstmt columns column-count) query - (let ((cc (result-columns-count hstmt))) - (when (zerop cc) + (when (zerop columncount) (error "can not bind columns, there is no result set")) - (setf column-count cc) + (setf column-count columncount) (setf columns (make-array column-count)) (dotimes (pos column-count) ;; the columns are 0 based, at least here (let ((col (create-column hstmt pos))) - (setf (aref columns pos) col)))))) + (setf (aref columns pos) col))))) (defun unbind-columns (query) @@ -344,6 +343,7 @@ (row-count (result-rows-count (hstmt query)))) (loop - (when (zerop (result-columns-count (hstmt query))) (return)) - (bind-columns query) + (let ((column-count (result-columns-count (hstmt query)))) + (when (zerop column-count) (return)) + (bind-columns query column-count) (let ((res (fetch-query-results query )) (names (coerce (column-names query) 'list))) @@ -351,5 +351,5 @@ (unbind-columns query) (unless (%sql-more-results (hstmt query)) - (return)))) + (return))))) (let ((return-parameters (get-parameters query))) (values row-count (nreverse res-list) return-parameters)))) @@ -493,5 +493,5 @@ (unless (= (column-count query) no-of-columns) (error "the number of columns has changed")) - (bind-columns query))) + (bind-columns query no-of-columns))) (values (fetch-query-results query) (coerce (column-names query) 'list))) Index: vendor/src/odbc/parameter.lisp =================================================================== --- vendor/src/odbc/parameter.lisp (revision vendor,6) +++ vendor/src/odbc/parameter.lisp (revision vendor,8) @@ -114,7 +114,5 @@ (put-string (slot-value param 'value-ptr) "")) (t - (cffi:lisp-string-to-foreign value - (slot-value param 'value-ptr) - (1+ (length value))) + (put-string (slot-value param 'value-ptr) value) (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) (length value))))) Index: vendor/src/test/test-sql-server.lisp =================================================================== --- vendor/src/test/test-sql-server.lisp (revision vendor,6) +++ vendor/src/test/test-sql-server.lisp (revision vendor,8) @@ -30,5 +30,9 @@ ss-test20 ss-test21 - ss-test22)) + ss-test22 + ss-test23 + ss-test24 + ss-test25 + ss-test26)) (pprint sym) (funcall sym con))) @@ -502,3 +506,23 @@ - +(defun ss-test24 (con) + (dolist (x '(234 123 237)) + (let ((res (exec-query con (format nil "select char(~A)as a" x)))) + (assert (= x (char-code (char (first (first res)) 0))))))) + +(defun ss-test25 (con) + (dolist (x '(234 123 237)) + (let ((res (exec-query con (format nil "select ascii('~A') as a" (code-char x))))) + (assert (= x (first (first res))))))) + +(defun ss-test26 (con) + (dolist (x '(234 123 237)) + (let ((res (exec-query con "select ? as a" (string (code-char x))))) + (assert (= x (char-code (char (first (first res)) 0))))))) + + + + + + +