r9411: fix caching of order-by clauses

diff --git a/ChangeLog b/ChangeLog
index c3435af8d023dbcf10ba56ecf23bcf6a7f61d003..5d045f511a02494a6cb089f809a334f6050f8f7d 100644 (file)
--- 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 2c647674ade9cb0f3915a050dd752ce9feeaca44..89fba73f24d0bdfffeef629b70e69001ecce94ec 100644 (file)
--- 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 <kmr@debian.org>  Wed, 19 May 2004 16:33:07 -0600
-
 cl-sql (2.10.18-1) unstable; urgency=low
 
   * New upstream
 
- -- Kevin M. Rosenberg <kmr@debian.org>  Sat, 15 May 2004 19:30:06 -0600
+ -- Kevin M. Rosenberg <kmr@debian.org>  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 413eae61630bbcddfaed113ad6857d61684df5b9..d708c8a4a8c945a5d521f52b7e6cde5e71023d6c 100644 (file)
--- 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 07652f21c7f77d7712b35ddde07da23a5c945997..af5aaea1c476cbd5f1b8690e5f8b110a8d1b88ef 100644 (file)
--- 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 438beaf3421565b7e471c06649e1df9be6dc334c..e9362c3783d8f77d9549355f0e2e0425ebcc1dc2 100644 (file)
--- 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 1d8c6948ba807a91bb68bb7658465e9211e3d90b..549ddbc631fd6545f774a962475b0f55a09357ec 100644 (file)
--- 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)))