From: Kevin M. Rosenberg Date: Sun, 3 Oct 2004 15:45:47 +0000 (+0000) Subject: r10083: Automated commit for Debian build of clsql upstream-version-3.0.8 X-Git-Tag: v3.8.6~223 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=c8237b2b84003326358882da1d3f93919231a1de r10083: Automated commit for Debian build of clsql upstream-version-3.0.8 --- diff --git a/ChangeLog b/ChangeLog index aa3d6f3..1eb770b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +03 Oct 2004 Kevin Rosenberg + * Version 3.0.8 released + * db-sqlite/sqlite-*.lisp: Apply patch from + Aurelio Bignoli with improvements + 01 Oct 2004 Kevin Rosenberg * multiple: Apply patch from Joerg Hoehle with multiple improvements. diff --git a/db-sqlite/sqlite-api.lisp b/db-sqlite/sqlite-api.lisp index 9866749..ad25a77 100644 --- 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 3ea54f6..689202a 100644 --- 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 61767d7..73caa4f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (3.0.8-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 3 Oct 2004 09:45:16 -0600 + cl-sql (3.0.7-1) unstable; urgency=low * New upstream