X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-api-uffi.lisp;h=939651522e882c093298297357ae658530031fd4;hb=7cdc9aa48baa3c52923d61da6fa632eb47ac0b5d;hp=3ed41ef5688a431ffab3a19e5f0632959372cf38;hpb=5ebf81b33d3fee557bd71bcdea1390903a8a1f50;p=clsql.git diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index 3ed41ef..9396515 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -10,6 +10,7 @@ ;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2003 by Aurelio Bignoli +;;;; and Copyright (c) 2003-2004 by Kevin Rosenberg ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -66,8 +67,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. @@ -86,7 +85,8 @@ :code code :message (if message message - (sqlite-error-string code))))) + (uffi:convert-from-cstring + (sqlite-error-string code)))))) (unless (signal condition) (invoke-debugger condition)))) @@ -100,6 +100,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 +221,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 +231,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 +253,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 +261,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 +275,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 +295,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 ()