From 56ccd9c18c38262936b8988264edfb927e83eb49 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 8 Apr 2004 17:44:57 +0000 Subject: [PATCH] r8879: fix sequence, fix sqlite uffi, fix schema table --- ChangeLog | 6 +++ db-mysql/mysql-sql.lisp | 10 ++-- db-sqlite/sqlite-api-uffi.lisp | 99 +++++++++++++++------------------- db-sqlite/sqlite-sql.lisp | 13 +++-- debian/changelog | 6 +++ sql/objects.lisp | 4 +- tests/test-fddl.lisp | 2 +- 7 files changed, 70 insertions(+), 70 deletions(-) diff --git a/ChangeLog b/ChangeLog index a4b5bb7..bdc14a0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +08 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.3.3 released + * Fixes for sequences on mysql and sqlite [Marcus Pearce] + * Fixes for uffi sqlite backend [Aurelio Bignoli / Kevin Rosenberg] + * Fix for schema table [Marcus Pearce] + 06 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * db-*/*-sql.lisp: Ensure that expr in database-query-result-set is a string diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index c33456c..75b81a8 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -294,8 +294,8 @@ (defmethod database-list-tables ((database mysql-database) &key (owner nil)) (declare (ignore owner)) (remove-if #'(lambda (s) - (and (>= (length s) 10) - (string= (subseq s 0 10) "_clsql_seq_"))) + (and (>= (length s) 11) + (string= (subseq s 0 11) "_clsql_seq_"))) (mapcar #'car (database-query "SHOW TABLES" database nil)))) ;; MySQL 4.1 does not support views @@ -343,9 +343,9 @@ (concatenate 'string "_clsql_seq_" (sql-escape sequence-name))) (defun %table-name-to-sequence-name (table-name) - (and (>= (length table-name) 10) - (string= (subseq table-name 0 10) "_clsql_seq_") - (subseq table-name 10))) + (and (>= (length table-name) 11) + (string= (subseq table-name 0 11) "_clsql_seq_") + (subseq table-name 11))) (defmethod database-create-sequence (sequence-name (database mysql-database)) diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index c140d18..e6af621 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -16,15 +16,6 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* - -;;; NOTE: Upon reviewing the code, I found this is not UFFI compatible. -;;; it appears to work on CMUCL, but does not work correctly on Lispworks -;;; and Allegro. Mostly, the processing of return strings is still incorrect -;;; UFFI code. -;;; To fix this will require reading the SQLite API and reworking the -;;; code below. -;;; - Kevin Rosenberg - (in-package #:cl-user) (defpackage #:sqlite @@ -100,20 +91,18 @@ ;;;; ;;;; Foreign types definitions. ;;;; +(def-foreign-type errmsg (* :char)) (def-foreign-type sqlite-db :pointer-void) (def-foreign-type sqlite-vm :pointer-void) -(def-foreign-type errmsg :cstring) - -(def-array-pointer string-array-pointer :cstring) +(def-foreign-type string-pointer (* (* :char))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lisp types used in declarations. ;;;; -(def-type sqlite-db-pointer (* sqlite-db)) -(def-type sqlite-int-pointer (* :int)) -(def-type sqlite-row string-array-pointer) -(def-type sqlite-row-pointer (* string-array-pointer)) +(def-type sqlite-db sqlite-db) +(def-type sqlite-row string-pointer) +(def-type sqlite-row-pointer (* string-pointer)) (def-type sqlite-vm-pointer (* sqlite-vm)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -166,8 +155,8 @@ ("sqlite_step" %step) ((vm sqlite-vm) (cols-n (* :int)) - (cols (* (* :char))) - (col-names (* (* :char)))) + (cols (* (* (* :char)))) + (col-names (* (* (* :char))))) :returning :int) (declaim (inline %finalize)) @@ -192,7 +181,7 @@ ("sqlite_get_table" %get-table) ((db sqlite-db) (sql :cstring) - (result (* (* :char))) + (result (* (* (* :char)))) (rows-n (* :int)) (cols-n (* :int)) (error-message (* errmsg))) @@ -222,31 +211,30 @@ (defparameter sqlite-version (sqlite-libversion)) (defparameter sqlite-encoding (sqlite-libencoding)) -(def-type sqlite-db-pointer-type sqlite-db-pointer) -(def-type sqlite-vm-pointer-type sqlite-vm-pointer) - (defun sqlite-open (db-name &optional (mode 0)) - (let ((db (%open db-name mode nil))) - (if (null-pointer-p db) - (signal-sqlite-error SQLITE-ERROR - (format nil "unable to open ~A" db-name)) - db))) + (with-cstring (db-name-native db-name) + (let ((db (%open db-name-native mode nil))) + (if (null-pointer-p db) + (signal-sqlite-error SQLITE-ERROR + (format nil "unable to open ~A" db-name)) + db)))) (defun sqlite-compile (db sql) - (let ((vm (allocate-foreign-object 'sqlite-vm))) - (with-foreign-object (sql-tail '(* :char)) - (let ((result (%compile db sql sql-tail vm nil))) - (if (= result SQLITE-OK) - vm - (progn - (free-foreign-object vm) - (signal-sqlite-error result))))))) + (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 nil))) + (if (= result SQLITE-OK) + vm + (progn + (free-foreign-object vm) + (signal-sqlite-error result)))))))) (defun sqlite-step (vm) - (declare (type sqlite-vm-pointer-type 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 '(* (* :char)))) + (col-names (allocate-foreign-object '(* (* :char))))) (declare (type sqlite-row-pointer cols col-names)) (let ((result (%step (deref-pointer vm 'sqlite-vm) cols-n cols col-names))) @@ -257,8 +245,8 @@ ((= result SQLITE-DONE) (free-foreign-object cols) (free-foreign-object col-names) - (values 0 (make-null-pointer 'string-array-pointer) - (make-null-pointer 'string-array-pointer))) + (values 0 (make-null-pointer 'string-pointer) + (make-null-pointer 'string-pointer))) (t (free-foreign-object cols) (free-foreign-object col-names) @@ -274,19 +262,20 @@ (signal-sqlite-error result)))) (defun sqlite-get-table (db sql) - (declare (type sqlite-db-pointer db)) - (let ((rows (allocate-foreign-object '(* :char)))) - (with-foreign-object (rows-n :int) - (with-foreign-object (cols-n :int) - (declare (type sqlite-row-pointer rows)) - (let ((result (%get-table db sql rows rows-n cols-n nil))) - (if (= result SQLITE-OK) - (let ((cn (deref-pointer cols-n :int)) - (rn (deref-pointer rows-n :int))) - (values rows rn cn)) - (progn - (free-foreign-object rows) - (signal-sqlite-error result)))))))) + (declare (type sqlite-db db)) + (with-cstring (sql-native sql) + (let ((rows (allocate-foreign-object '(* (* :char))))) + (declare (type sqlite-row-pointer 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 nil))) + (if (= result SQLITE-OK) + (let ((cn (deref-pointer cols-n :int)) + (rn (deref-pointer rows-n :int))) + (values rows rn cn)) + (progn + (free-foreign-object rows) + (signal-sqlite-error result))))))))) (declaim (inline sqlite-free-table)) (defun sqlite-free-table (table) @@ -299,7 +288,7 @@ ;;;; (declaim (inline make-null-row)) (defun make-null-row () - (uffi:make-null-pointer 'string-array-pointer)) + (uffi:make-null-pointer 'string-pointer)) (declaim (inline make-null-vm)) (defun make-null-vm () @@ -312,7 +301,7 @@ (declaim (inline sqlite-aref)) (defun sqlite-aref (a n) (declare (type sqlite-row-pointer a)) - (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array :char) n)) + (convert-from-foreign-string (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array :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 6fd3f07..63edf07 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -137,7 +137,6 @@ :error (sqlite:sqlite-error-message err))))) (defmethod database-dump-result-set (result-set (database sqlite-database)) - (declare (ignore database)) (handler-case (sqlite:sqlite-finalize (sqlite-result-set-vm result-set)) (sqlite:sqlite-error (err) @@ -186,8 +185,8 @@ (declare (ignore owner)) ;; Query is copied from .table command of sqlite comamnd line utility. (remove-if #'(lambda (s) - (and (>= (length s) 10) - (string= (subseq s 0 10) "_clsql_seq_"))) + (and (>= (length s) 11) + (string= (subseq s 0 11) "_clsql_seq_"))) (mapcar #'car (database-query "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name" database '())))) @@ -229,9 +228,9 @@ (concatenate 'string "_clsql_seq_" (sql-escape sequence-name))) (defun %table-name-to-sequence-name (table-name) - (and (>= (length table-name) 10) - (string= (subseq table-name 0 10) "_clsql_seq_") - (subseq table-name 10))) + (and (>= (length table-name) 11) + (string= (subseq table-name 0 11) "_clsql_seq_") + (subseq table-name 11))) (defmethod database-create-sequence (sequence-name (database sqlite-database)) @@ -282,4 +281,4 @@ (sqlite:sqlite-last-insert-rowid (sqlite-db database)))) (defmethod database-sequence-last (sequence-name (database sqlite-database)) - (declare (ignore sequence-name database))) + (declare (ignore sequence-name))) diff --git a/debian/changelog b/debian/changelog index 9a394b8..043ac49 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.3.3-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 8 Apr 2004 11:33:59 -0600 + cl-sql (2.3.2-2) unstable; urgency=low * New upstreamc diff --git a/sql/objects.lisp b/sql/objects.lisp index f4caac8..a397b87 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -104,9 +104,9 @@ (defun ensure-schema-version-table (database) (unless (table-exists-p "clsql_object_v" :database database) - (create-table [clsql_object_v] '(([name] (string 32)) + (create-table [clsql_object_v] '(([name] string) ([vers] integer) - ([def] (string 32))) + ([def] string)) :database database))) (defun update-schema-version-records (view-class-name diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index 0d8b3cf..e45d04e 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -24,7 +24,7 @@ (sort (mapcar #'string-downcase (clsql:list-tables :owner *test-database-user*)) #'string>)) - "clsql_object_v" "employee" "company") + "employee" "company" "clsql_object_v") ;; create a table, test for its existence, drop it and test again (deftest :fddl/table/2 -- 2.34.1