From e7359cb3f285d3a53b768b13484caf11bc6f47b1 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 1 May 2004 20:07:04 +0000 Subject: [PATCH] r9191: improve sqlite result-types processing, passes all tests --- ChangeLog | 8 ++++++++ clsql-sqlite.asd | 2 +- db-sqlite/sqlite-api-uffi.lisp | 22 +++++++++++----------- db-sqlite/sqlite-sql.lisp | 9 ++++++++- debian/changelog | 6 ++++++ 5 files changed, 34 insertions(+), 13 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7b57d6a..dbf9824 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +1 May 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.10.5: SQLite backend now passes all result-types tests + * clsql-sqlite.asd: Depend on clsql-uffi system + * db-sqlite/sqlite-sql.lisp: Use clsql-uffi:convert-raw-field + for efficiency and code reuse. + * db-sqlite/sqlite-api-uffi.lisp: Change (* :char) to (* :unsigned-char) + for better cross-implementation compatibility. + 1 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.10.4 * sql/tables.lisp: Fix typo in CACHE-TABLE-QUERIES diff --git a/clsql-sqlite.asd b/clsql-sqlite.asd index a9a5e70..6a82c6c 100644 --- a/clsql-sqlite.asd +++ b/clsql-sqlite.asd @@ -28,7 +28,7 @@ :long-description "cl-sql-sqlite package provides a database driver to SQLite database library." - :depends-on (#-clisp uffi clsql-base) + :depends-on (clsql-base #-clisp clsql-uffi) :components ((:module :db-sqlite :components diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index 9396515..39f064a 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -94,10 +94,10 @@ ;;;; ;;;; Foreign types definitions. ;;;; -(def-foreign-type errmsg (* :char)) +(def-foreign-type errmsg (* :unsigned-char)) (def-foreign-type sqlite-db :pointer-void) (def-foreign-type sqlite-vm :pointer-void) -(def-foreign-type string-pointer (* (* :char))) +(def-foreign-type string-pointer (* (* :unsigned-char))) (def-foreign-type sqlite-row-pointer (* string-pointer)) (defvar +null-errmsg-pointer+ (make-null-pointer 'errmsg)) @@ -153,7 +153,7 @@ ("sqlite_compile" %compile) ((db sqlite-db) (sql :cstring) - (sql-tail (* (* :char))) + (sql-tail (* (* :unsigned-char))) (vm (* sqlite-vm)) (error-message (* errmsg))) :returning :int) @@ -163,8 +163,8 @@ ("sqlite_step" %step) ((vm sqlite-vm) (cols-n (* :int)) - (cols (* (* (* :char)))) - (col-names (* (* (* :char))))) + (cols (* (* (* :unsigned-char)))) + (col-names (* (* (* :unsigned-char))))) :returning :int) (declaim (inline %finalize)) @@ -189,7 +189,7 @@ ("sqlite_get_table" %get-table) ((db sqlite-db) (sql :cstring) - (result (* (* (* :char)))) + (result (* (* (* :unsigned-char)))) (rows-n (* :int)) (cols-n (* :int)) (error-message (* errmsg))) @@ -230,7 +230,7 @@ (defun sqlite-compile (db sql) (with-cstring (sql-native sql) (let ((vm (allocate-foreign-object 'sqlite-vm))) - (with-foreign-object (sql-tail '(* :char)) + (with-foreign-object (sql-tail '(* :unsigned-char)) (let ((result (%compile db sql-native sql-tail vm +null-errmsg-pointer+))) (if (= result SQLITE-OK) vm @@ -241,8 +241,8 @@ (defun sqlite-step (vm) (declare (type sqlite-vm-pointer vm)) (with-foreign-object (cols-n :int) - (let ((cols (allocate-foreign-object '(* (* :char)))) - (col-names (allocate-foreign-object '(* (* :char))))) + (let ((cols (allocate-foreign-object '(* (* :unsigned-char)))) + (col-names (allocate-foreign-object '(* (* :unsigned-char))))) (declare (type sqlite-row-pointer-type cols col-names)) (let ((result (%step (deref-pointer vm 'sqlite-vm) cols-n cols col-names))) @@ -271,7 +271,7 @@ (defun sqlite-get-table (db sql) (declare (type sqlite-db-type db)) (with-cstring (sql-native sql) - (let ((rows (allocate-foreign-object '(* (* :char))))) + (let ((rows (allocate-foreign-object '(* (* :unsigned-char))))) (declare (type sqlite-row-pointer-type rows)) (with-foreign-object (rows-n :int) (with-foreign-object (cols-n :int) @@ -309,7 +309,7 @@ (defun sqlite-aref (a n) (declare (type sqlite-row-pointer-type a)) (convert-from-foreign-string - (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :char)) n))) + (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :unsigned-char)) n))) (declaim (inline sqlite-free-row)) (defun sqlite-free-row (row) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 8aad430..befc885 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -150,7 +150,7 @@ collect (case type ((:int :integer :tinyint :long :bigint) - :integer) + :int32) ((:float :double) :double) ((:numeric) @@ -195,6 +195,13 @@ (loop for i = 0 then (1+ i) for rest on list do (setf (car rest) + #-clisp + (clsql-uffi:convert-raw-field + (uffi:deref-array + (uffi:deref-pointer row 'sqlite:sqlite-row-pointer) '(:array (* :char)) i) + result-types + i) + #+clisp (let ((type (if result-types (nth i result-types) :string)) diff --git a/debian/changelog b/debian/changelog index 2f7f84b..23e7926 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.10.5-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sat, 1 May 2004 14:06:43 -0600 + cl-sql (2.10.4-1) unstable; urgency=low * New upstream -- 2.34.1