fixed a bug where the order by was being destructively modified,

causing odd caching issues when the selected object was not statically
known (eg unreferenced tables could show up in the query if they were
cached by a previous call through this function.  I replaced this code
with a non-destructive variant which should solve this.

Thanks to Philipp Marek for the bug report

diff --git a/ChangeLog b/ChangeLog
index 05224342b7350fc4cb1c6fec156cb3fdffcf94b2..b01b25409e9e5b5bf99d750b4212565d1be0b563 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2012-07-09  Russ Tyndall  <russ@acceleration.net>
+        * sql/oodml.lisp - fixed a bug where the order by was being
+       destructively modified, causing odd caching issues when the
+       selected object was not statically known (eg unreferenced tables
+       could show up in the query if they were cached by a previous call
+       through this function.  I replaced this code with a
+       non-destructive variant which should solve this.
+
+       Thanks to Philipp Marek for the bug report
+
 2012-06-25  Russ Tyndall  <russ@acceleration.net>
        * sql/util.lisp, sql/metaclasses.lisp
        Dequote database-identifiers if needed (passed a quoted symbol)

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index d38d3b94ded9ad1b3fb03c3944173bc0540115e5..d61c58a59971c31b304aaf1f703328247ae9e9b2 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -1267,19 +1267,26 @@ as elements of a list."
            (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))))
-               (labels ((set-table-if-needed (val)
+               (labels ((sv (val name) (ignore-errors (slot-value val name)))
+                        (set-table-if-needed (val)
                           (typecase val
                             (sql-ident-attribute
                              (handler-case
-                                 (unless (slot-value val 'qualifier)
-                                   (setf (slot-value val 'qualifier) table-name))
+                                 (if (sv val 'qualifier)
+                                     val
+                                     (make-instance 'sql-ident-attribute
+                                                    :name (sv val 'name)
+                                                    :qualifier table-name))
                                (simple-error ()
                                  ;; TODO: Check for a specific error we expect
                                  )))
-                            (cons (set-table-if-needed (car val))))))
-                 (loop for i from 0 below (length order-by-list)
-                       for id = (nth i order-by-list)
-                       do (set-table-if-needed id)))
+                            (cons (cons (set-table-if-needed (car val))
+                                        (cdr val)))
+                            (t val))))
+                 (setf order-by-list
+                       (loop for i from 0 below (length order-by-list)
+                             for id in order-by-list
+                             collect (set-table-if-needed id))))
                (setf (getf qualifier-args :order-by) order-by-list))))
 
          (cond