From 43ee802384af388413dd7f3072f7aefd6c90240d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 20 May 2004 09:49:51 +0000 Subject: [PATCH] r9411: fix caching of order-by clauses --- ChangeLog | 4 ++++ debian/changelog | 9 +-------- sql/conditions.lisp | 7 +++++-- sql/objects.lisp | 32 ++++++++++++++++++++++---------- sql/package.lisp | 7 ++++--- tests/test-oodml.lisp | 6 +++--- 6 files changed, 39 insertions(+), 26 deletions(-) diff --git a/ChangeLog b/ChangeLog index c3435af..5d045f5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,14 @@ 19 May 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.10.18 released: New condition hierarchy to be compatible + with CommonSQL -- not backward compatible with previous CLSQL. * sql/db-interface.lisp: Add more default methods * sql/objects.lisp: Add explicit table name to order-by parameters in find-all when only one table to avoid selecting a duplicate row. Fix error in FIND-ALL when using :order-by such as (([foo] :asc)) as previous logic was adding two fields (foo asc) to SELECT query. Make :result-types :auto be the default for object selections. + Properly handle caching key when using multiple order-by with asc/desc + directions. * db-oracle/*.lisp: Much improvements, now passes 90% of test suite 19 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) diff --git a/debian/changelog b/debian/changelog index 2c64767..89fba73 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,15 +1,8 @@ -cl-sql (2.10.19-1) unstable; urgency=low - - * New upstream - * Fix depends [patch from Erik Naggum] - - -- Kevin M. Rosenberg Wed, 19 May 2004 16:33:07 -0600 - cl-sql (2.10.18-1) unstable; urgency=low * New upstream - -- Kevin M. Rosenberg Sat, 15 May 2004 19:30:06 -0600 + -- Kevin M. Rosenberg Thu, 20 May 2004 03:48:26 -0600 cl-sql (2.10.17-1) unstable; urgency=low diff --git a/sql/conditions.lisp b/sql/conditions.lisp index 413eae6..d708c8a 100644 --- a/sql/conditions.lisp +++ b/sql/conditions.lisp @@ -25,7 +25,10 @@ set to :error to signal an error or :ignore/nil to silently ignore the warning." (define-condition sql-condition () ()) -(define-condition sql-database-error (simple-error sql-condition) +(define-condition sql-error (simple-error) + ()) + +(define-condition sql-database-error (sql-error) ((error-id :initarg :error-id :initform nil :reader sql-error-error-id) @@ -74,7 +77,7 @@ set to :error to signal an error or :ignore/nil to silently ignore the warning." (define-condition sql-temporary-error (sql-database-error) ()) -(define-condition sql-user-error (simple-error sql-condition) +(define-condition sql-user-error (sql-error) ((message :initarg :message :initform "Unspecified error" :reader sql-user-error-message)) diff --git a/sql/objects.lisp b/sql/objects.lisp index 07652f2..af5aaea 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -1021,16 +1021,7 @@ superclass of the newly-defined View Class." :test #'tables-equal))) (order-by-slots (mapcar #'(lambda (ob) (if (atom ob) ob (car ob))) (listify order-by)))) - - (when (and order-by-slots (= 1 (length tables))) - ;; Add explicity table name if not specified and only one selected table - (let ((table-name (sql-output (car tables) database))) - (loop for i from 0 below (length order-by-slots) - do (when (typep (nth i order-by-slots) 'sql-ident-attribute) - (unless (slot-value (nth i order-by-slots) 'qualifier) - (setf (slot-value (nth i order-by-slots) 'qualifier) table-name)))))) - (dolist (ob order-by-slots) (when (and ob (not (member ob (mapcar #'cdr fullsels) :test #'ref-equal))) @@ -1136,10 +1127,30 @@ ENABLE-SQL-READER-SYNTAX." (let ((caching (getf qualifier-args :caching t)) (result-types (getf qualifier-args :result-types :auto)) (refresh (getf qualifier-args :refresh nil)) - (database (or (getf qualifier-args :database) *default-database*))) + (database (or (getf qualifier-args :database) *default-database*)) + (order-by (getf qualifier-args :order-by))) (remf qualifier-args :caching) (remf qualifier-args :refresh) (remf qualifier-args :result-types) + + + ;; Add explicity table name to order-by if not specified and only + ;; one selected table. This is required so FIND-ALL won't duplicate + ;; the field + (when (and order-by (= 1 (length target-args))) + (let ((table-name (view-table (find-class (car target-args)))) + (order-by-list (copy-seq (listify order-by)))) + + (loop for i from 0 below (length order-by-list) + do (etypecase (nth i order-by-list) + (sql-ident-attribute + (unless (slot-value (nth i order-by-list) 'qualifier) + (setf (slot-value (nth i order-by-list) 'qualifier) table-name))) + (cons + (unless (slot-value (car (nth i order-by-list)) 'qualifier) + (setf (slot-value (car (nth i order-by-list)) 'qualifier) table-name))))) + (setf (getf qualifier-args :order-by) order-by-list))) + (cond ((null caching) (apply #'find-all target-args @@ -1194,6 +1205,7 @@ ENABLE-SQL-READER-SYNTAX." (when value (push (list arg (typecase value + (cons (cons (sql (car value)) (cdr value))) (%sql-expression (sql value)) (t value))) results)))))) diff --git a/sql/package.lisp b/sql/package.lisp index 438beaf..e9362c3 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -229,10 +229,11 @@ #:sql-error-database-message ;; CLSQL Extensions - #:sql-database-warning - #:sql-warning #:sql-condition - + #:sql-error + #:sql-warning + #:sql-database-warning + ;;FDDL #:create-table ; table xx #:drop-table ; table xx diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index 1d8c694..549ddbc 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -154,7 +154,7 @@ (deftest :oodm/retrieval/8 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number)) - (select 'employee-address :flatp t :order-by [ea_join aaddressid] :caching nil)) + (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)) (10 10 nil nil nil)) (deftest :oodm/retrieval/9 @@ -403,7 +403,7 @@ t) (deftest :oodml/refresh/2 - (let* ((addresses (select 'address :order-by [addressid] :flatp t)) + (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t)) (city (slot-value (car addresses) 'city))) (clsql:update-records [addr] :av-pairs '((city_field "A new city")) @@ -427,7 +427,7 @@ nil nil) (deftest :oodml/refresh/4 - (let* ((addresses (select 'address :order-by [addressid] :flatp t)) + (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t)) (*db-auto-sync* t)) (make-instance 'address :addressid 1000 :city "A new address city") (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t))) -- 2.34.1