From 3e67ee0887558908069b0d1f2a72abfae3725799 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 19 Apr 2004 01:16:25 +0000 Subject: [PATCH] r9082: fix sequence, error-string --- ChangeLog | 6 ++++ db-sqlite/sqlite-api-uffi.lisp | 3 +- db-sqlite/sqlite-sql.lisp | 61 ++++++++++++++++++++++------------ debian/changelog | 6 ++++ tests/test-fddl.lisp | 32 +++++++++--------- 5 files changed, 69 insertions(+), 39 deletions(-) diff --git a/ChangeLog b/ChangeLog index faa66e6..3ea33bc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +18 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.7.9 + * db-sqlite/sqlite-sql.lisp: Fix sequence functions. + * db-sqlite/sqlite-api-uffi.lisp: Print error string + correctly. + 18 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.7.7 * doc/csql.xml, examples/clsql-tutorial.lisp: Patch for db-kind diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index 77649a5..73a12eb 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -84,7 +84,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)))) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 1f3c158..1ea5599 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -234,22 +234,23 @@ (string= (subseq table-name 0 11) "_clsql_seq_") (subseq table-name 11))) + (defmethod database-create-sequence (sequence-name (database sqlite-database)) (let ((table-name (%sequence-name-to-table-name sequence-name))) (database-execute-command (concatenate 'string "CREATE TABLE " table-name - " (id INTEGER PRIMARY KEY)") + " (last_value integer PRIMARY KEY, increment_by integer, min_value integer, is_called char(1))") database) (database-execute-command - (format nil "INSERT INTO ~A VALUES (-1)" table-name) + (concatenate 'string "INSERT INTO " table-name + " VALUES (1,1,1,'f')") database))) (defmethod database-drop-sequence (sequence-name (database sqlite-database)) (database-execute-command - (concatenate 'string "DROP TABLE " - (%sequence-name-to-table-name sequence-name)) + (concatenate 'string "DROP TABLE " (%sequence-name-to-table-name sequence-name)) database)) (defmethod database-list-sequences ((database sqlite-database) @@ -263,27 +264,45 @@ database '()))) (defmethod database-sequence-next (sequence-name (database sqlite-database)) - (let ((table-name (%sequence-name-to-table-name sequence-name))) - (database-execute-command - (format nil "UPDATE ~A SET id=(SELECT id FROM ~A)+1" - table-name table-name) - database) - (sqlite:sqlite-last-insert-rowid (sqlite-db database)) - (parse-integer - (caar (database-query (format nil "SELECT id from ~A" table-name) - database nil))))) + (without-interrupts + (let* ((table-name (%sequence-name-to-table-name sequence-name)) + (tuple + (car (database-query + (concatenate 'string "SELECT last_value,is_called FROM " + table-name) + database + :auto)))) + (cond + ((char-equal (schar (second tuple) 0) #\f) + (database-execute-command + (format nil "UPDATE ~A SET is_called='t'" table-name) + database) + (parse-integer (car tuple))) + (t + (let ((new-pos (1+ (parse-integer (car tuple))))) + (database-execute-command + (format nil "UPDATE ~A SET last_value=~D" table-name new-pos) + database) + new-pos)))))) + +(defmethod database-sequence-last (sequence-name (database sqlite-database)) + (without-interrupts + (parse-integer + (caar (database-query + (concatenate 'string "SELECT last_value FROM " + (%sequence-name-to-table-name sequence-name)) + database + :auto))))) (defmethod database-set-sequence-position (sequence-name (position integer) (database sqlite-database)) - (let ((table-name (%sequence-name-to-table-name sequence-name))) - (database-execute-command - (format nil "UPDATE ~A SET id=~A" table-name position) - database) - (sqlite:sqlite-last-insert-rowid (sqlite-db database)))) - -(defmethod database-sequence-last (sequence-name (database sqlite-database)) - (declare (ignore sequence-name))) + (database-execute-command + (format nil "UPDATE ~A SET last_value=~A,is_called='t'" + (%sequence-name-to-table-name sequence-name) + position) + database) + position) (defmethod database-create (connection-spec (type (eql :sqlite))) (declare (ignore connection-spec)) diff --git a/debian/changelog b/debian/changelog index 2cac263..b9f2830 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.7.9-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 18 Apr 2004 19:16:14 -0600 + cl-sql (2.7.8-1) unstable; urgency=low * New upstream diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index def32cb..bafa1c5 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -131,25 +131,23 @@ ;; not in sqlite (deftest :fddl/view/4 - (if (eql *test-database-type* :sqlite) - (values nil '(("Josef" "Stalin" "stalin@soviet.org"))) - (progn (clsql:create-view [lenins-group] - :column-list '([forename] [surname] [email]) - :as [select [first-name] [last-name] [email] - :from [employee] - :where [= [managerid] 1]]) - (let ((result - (list - ;; Shouldn't exist + (progn (clsql:create-view [lenins-group] + :column-list '([forename] [surname] [email]) + :as [select [first-name] [last-name] [email] + :from [employee] + :where [= [managerid] 1]]) + (let ((result + (list + ;; Shouldn't exist (clsql:select [forename] [surname] [email] - :from [lenins-group] - :where [= [surname] "Lenin"]) - ;; Should exist + :from [lenins-group] + :where [= [surname] "Lenin"]) + ;; Should exist (car (clsql:select [forename] [surname] [email] - :from [lenins-group] - :where [= [surname] "Stalin"]))))) - (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) - (apply #'values result)))) + :from [lenins-group] + :where [= [surname] "Stalin"]))))) + (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) + (apply #'values result))) nil ("Josef" "Stalin" "stalin@soviet.org")) ;; create an index, test for existence, drop it and test again -- 2.34.1