From b475f491ffc24cacd2d7250e356a3d3a15532e94 Mon Sep 17 00:00:00 2001
From: Russ Tyndall <russ@acceleration.net>
Date: Mon, 9 Jul 2012 17:11:54 -0400
Subject: [PATCH] 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
---
 ChangeLog      | 10 ++++++++++
 sql/oodml.lisp | 21 ++++++++++++++-------
 2 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0522434..b01b254 100644
--- 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 d38d3b9..d61c58a 100644
--- 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
-- 
2.34.1