r10083: Automated commit for Debian build of clsql upstream-version-3.0.8

diff --git a/ChangeLog b/ChangeLog
index aa3d6f314257bfbbef9460d22339d9481963add4..1eb770bedd721961626bbcde2c3db7470f72876f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+03 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 3.0.8 released
+       * db-sqlite/sqlite-*.lisp: Apply patch from
+       Aurelio Bignoli with improvements
+       
 01 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * multiple: Apply patch from Joerg Hoehle with multiple
        improvements.

diff --git a/db-sqlite/sqlite-api.lisp b/db-sqlite/sqlite-api.lisp
index 98667493ad0c94c581019abcfb65b9bc7f9f208a..ad25a77c991b1b874ed004a4f5615d6c3df82a2a 100644 (file)
--- a/db-sqlite/sqlite-api.lisp
+++ b/db-sqlite/sqlite-api.lisp
@@ -48,6 +48,7 @@
           #:make-null-vm
           #:null-row-p
           #:sqlite-aref
+          #:sqlite-raw-aref
           #:sqlite-free-row
           
           ;;; Types.
@@ -311,6 +312,11 @@
   (convert-from-foreign-string
    (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :unsigned-char)) n)))
 
+(declaim (inline sqlite-raw-aref))
+(defun sqlite-raw-aref (a n)
+  (declare (type sqlite-row-pointer-type a))
+  (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :unsigned-char)) n))
+
 (declaim (inline sqlite-free-row))
 (defun sqlite-free-row (row)
   (declare (type sqlite-row-pointer-type row))

diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp
index 3ea54f624e51b23fa3580ded1681525bb34806a2..689202ac9184b9169378c0e2846216ccb4160dc3 100644 (file)
--- a/db-sqlite/sqlite-sql.lisp
+++ b/db-sqlite/sqlite-sql.lisp
@@ -87,20 +87,39 @@
 (defmethod database-query (query-expression (database sqlite-database) result-types field-names)
   (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
   (handler-case
-      (multiple-value-bind (result-set n-col)
-         (database-query-result-set query-expression database
-                                    :result-types result-types
-                                    :full-set nil)
-       (do* ((rows nil)
-             (col-names (when field-names
-                          (loop for j from 0 below n-col
-                                collect (sqlite:sqlite-aref (sqlite-result-set-col-names result-set) j))))
-             (new-row (make-list n-col) (make-list n-col))
-             (row-ok (database-store-next-row result-set database new-row)
-                     (database-store-next-row result-set database new-row)))
-            ((not row-ok)
-             (values (nreverse rows) col-names))
-         (push new-row rows)))
+      (let ((vm (sqlite:sqlite-compile (sqlite-db database)
+                                      query-expression))
+           (rows '())
+           (col-names '()))
+       (unwind-protect
+            ;; Read the first row to get column number and names.
+            (multiple-value-bind (n-col new-row sqlite-col-names)
+                (sqlite:sqlite-step vm)
+              (declare (type sqlite:sqlite-row-pointer-type new-row))
+              (when (> n-col 0)
+                (when field-names
+                  (setf col-names (loop for i from 0 below n-col
+                                        collect (sqlite:sqlite-aref sqlite-col-names i))))
+                (let ((canonicalized-result-types 
+                       (canonicalize-result-types result-types n-col sqlite-col-names)))
+                  (flet ((extract-row-data (row)
+                           (declare (type sqlite:sqlite-row-pointer-type row))
+                           (loop for i from 0 below n-col
+                                 collect (clsql-uffi:convert-raw-field
+                                          (sqlite:sqlite-raw-aref row i)
+                                          canonicalized-result-types i))))
+                    (push (extract-row-data new-row) rows)
+
+                    ;; Read subsequent rows.
+                    (do () (nil)
+                      (multiple-value-bind (n-col new-row)
+                          (sqlite:sqlite-step vm)
+                        (declare (type sqlite:sqlite-row-pointer-type new-row))
+                        (if (> n-col 0)
+                            (push (extract-row-data new-row) rows)
+                            (return))))))))
+         (sqlite:sqlite-finalize vm))
+       (values (nreverse rows) col-names))
     (sqlite:sqlite-error (err)
       (error 'sql-database-data-error
             :database database
@@ -111,31 +130,40 @@
 (defmethod database-query-result-set ((query-expression string)
                                      (database sqlite-database)
                                      &key result-types full-set)
-  (handler-case
-      (let ((vm (sqlite:sqlite-compile (sqlite-db database)
-                                      query-expression)))
-       ;;; To obtain column number/datatypes we have to read the first row.
-       (multiple-value-bind (n-col cols col-names)
-           (sqlite:sqlite-step vm)
-         (let ((result-set (make-sqlite-result-set
-                            :vm vm
-                            :first-row cols
-                            :n-col n-col
-                            :col-names col-names
-                            :result-types
-                            (canonicalize-result-types
-                             result-types
-                             n-col
-                             col-names))))
-           (if full-set
-               (values result-set n-col nil)
-               (values result-set n-col)))))
-    (sqlite:sqlite-error (err)
-      (error 'sql-database-data-error
-            :database database
-            :expression query-expression
-            :error-id (sqlite:sqlite-error-code err)
-            :message (sqlite:sqlite-error-message err)))))
+  (let ((vm nil))
+    (handler-case
+       (progn
+         (setf vm (sqlite:sqlite-compile (sqlite-db database)
+                                         query-expression))
+         ;;; To obtain column number/datatypes we have to read the first row.
+         (multiple-value-bind (n-col cols col-names)
+             (sqlite:sqlite-step vm)
+           (declare (type sqlite:sqlite-row-pointer-type cols))
+           (let ((result-set (make-sqlite-result-set
+                              :vm vm
+                              :first-row cols
+                              :n-col n-col
+                              :col-names col-names
+                              :result-types
+                              (canonicalize-result-types
+                               result-types
+                               n-col
+                               col-names))))
+             (if full-set
+                 (values result-set n-col nil)
+                 (values result-set n-col)))))
+      (sqlite:sqlite-error (err)
+       (progn
+         (when vm
+           ;; The condition was thrown by sqlite-step, vm must be
+           ;; deallocated.
+           (ignore-errors
+             (sqlite:sqlite-finalize vm)))
+         (error 'sql-database-data-error
+                :database database
+                :expression query-expression
+                :error-id (sqlite:sqlite-error-code err)
+                :message (sqlite:sqlite-error-message err))11)))))
 
 (defun canonicalize-result-types (result-types n-col col-names)
   (when result-types
@@ -196,8 +224,7 @@
                for rest on list
                do (setf (car rest)
                         (clsql-uffi:convert-raw-field
-                         (uffi:deref-array
-                          (uffi:deref-pointer row 'sqlite:sqlite-row-pointer) '(:array (* :unsigned-char)) i)
+                         (sqlite:sqlite-raw-aref row i)
                          result-types
                          i)))
          (sqlite:sqlite-free-row row)

diff --git a/debian/changelog b/debian/changelog
index 61767d74a3605a1a8e853ff0c667174e6f9181de..73caa4f0d2e2d646ab33dda2bc5f25b434395f0c 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (3.0.8-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sun,  3 Oct 2004 09:45:16 -0600
+
 cl-sql (3.0.7-1) unstable; urgency=low
 
   * New upstream