r8879: fix sequence, fix sqlite uffi, fix schema table

diff --git a/ChangeLog b/ChangeLog
index a4b5bb764504a8b4ce5c1720b2c47ab7774e1158..bdc14a03db9c10176088b519915df3fb820cf1b6 100644 (file)
--- 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 c33456c6050fdc33f716b134aaef30c2ecef43ff..75b81a8a88a0a19d9db90462b66b9fe2f0530cbd 100644 (file)
--- 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 c140d181f84228638e902fa8bc0ed6d36dd634c6..e6af621cec4b67e2a6736e1734c2f99fad94fb01 100644 (file)
--- 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 6fd3f0746a2ab663bc1c1f3eda881ffe91360279..63edf07532ee8fae3e0e97b3aa5a3a0d6b244c83 100644 (file)
--- 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 9a394b82ef58ab2719406220b2ac372301935d16..043ac4983da3a693803cec078d53e1dce9415697 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (2.3.3-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  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 f4caac808716395e01318547f3358a097ba6cc86..a397b87eead6f1e035d98203a38b58a7e6f0db31 100644 (file)
--- 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 0d8b3cf1e18596d35f9a878147bf9b617bb02ead..e45d04e103a702aa5346e536330feebf07d8b873 100644 (file)
--- 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