From f68111d8749473df1879d4431aa7c74ee2eea87d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 9 Apr 2004 01:33:11 +0000 Subject: [PATCH] r8892: uffi fixes --- ChangeLog | 4 ++-- db-sqlite/sqlite-api-uffi.lisp | 18 ++++++++++-------- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3e164b6..348d919 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,8 +7,8 @@ * classic-tests/tests.lisp: Fix package name of number-to-sql-string. * clsql.asd/clsql-tests.asd: Add support for asdf:test-op - * db-sqlite/sqlite-api-uffi.lisp: Fix type UFFI usage - found by testing on OpenMCL + * db-sqlite/sqlite-api-{uffi,sql}.lisp: Multiple UFFI fixes, + now passes tests on all support UFFI platforms. * db-postgresql-socket/postgresql-socket-api.list: Ported to SBCL * multiple: Finish renaming of :types keyword to :result-types for diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index 3ed41ef..77649a5 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -66,8 +66,6 @@ (defconstant SQLITE-ROW 100 "sqlite_step() has another row ready") (defconstant SQLITE-DONE 101 "sqlite_step() has finished executing") -(defvar +null-char-char-pointer+ (make-null-pointer 'string-pointer)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Conditions. @@ -100,6 +98,10 @@ (def-foreign-type string-pointer (* (* :char))) (def-foreign-type sqlite-row-pointer (* string-pointer)) +(defvar +null-errmsg-pointer+ (make-null-pointer 'errmsg)) +(defvar +null-string-pointer-pointer+ (make-null-pointer 'string-pointer)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lisp types used in declarations. @@ -217,7 +219,7 @@ (defun sqlite-open (db-name &optional (mode 0)) (with-cstring (db-name-native db-name) - (let ((db (%open db-name-native mode +null-char-char-pointer+))) + (let ((db (%open db-name-native mode +null-errmsg-pointer+))) (if (null-pointer-p db) (signal-sqlite-error SQLITE-ERROR (format nil "unable to open ~A" db-name)) @@ -227,7 +229,7 @@ (with-cstring (sql-native sql) (let ((vm (allocate-foreign-object 'sqlite-vm))) (with-foreign-object (sql-tail '(* :char)) - (let ((result (%compile db sql-native sql-tail vm +null-char-char-pointer+))) + (let ((result (%compile db sql-native sql-tail vm +null-errmsg-pointer+))) (if (= result SQLITE-OK) vm (progn @@ -249,7 +251,7 @@ ((= result SQLITE-DONE) (free-foreign-object cols) (free-foreign-object col-names) - (values 0 +null-char-char-pointer+ +null-char-char-pointer+)) + (values 0 +null-string-pointer-pointer+ +null-string-pointer-pointer+)) (t (free-foreign-object cols) (free-foreign-object col-names) @@ -257,7 +259,7 @@ (defun sqlite-finalize (vm) (declare (type sqlite-vm-pointer vm)) - (let ((result (%finalize (deref-pointer vm 'sqlite-vm) +null-char-char-pointer+))) + (let ((result (%finalize (deref-pointer vm 'sqlite-vm) +null-errmsg-pointer+))) (if (= result SQLITE-OK) (progn (free-foreign-object vm) @@ -271,7 +273,7 @@ (declare (type sqlite-row-pointer-type rows)) (with-foreign-object (rows-n :int) (with-foreign-object (cols-n :int) - (let ((result (%get-table db sql-native rows rows-n cols-n +null-char-char-pointer+))) + (let ((result (%get-table db sql-native rows rows-n cols-n +null-errmsg-pointer+))) (if (= result SQLITE-OK) (let ((cn (deref-pointer cols-n :int)) (rn (deref-pointer rows-n :int))) @@ -291,7 +293,7 @@ ;;;; (declaim (inline make-null-row)) (defun make-null-row () - +null-char-char-pointer+) + +null-string-pointer-pointer+) (declaim (inline make-null-vm)) (defun make-null-vm () -- 2.34.1