X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Foodml.lisp;h=d61c58a59971c31b304aaf1f703328247ae9e9b2;hb=b475f491ffc24cacd2d7250e356a3d3a15532e94;hp=6397fa88dd82a73838fb5f900220243bf5a8715f;hpb=91fd65e6ca4e4d7a9c1e0f8b6d860f55b2107437;p=clsql.git diff --git a/sql/oodml.lisp b/sql/oodml.lisp index 6397fa8..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 @@ -1344,11 +1351,8 @@ as elements of a list." (defun (setf records-cache-results) (results targets qualifiers database) (unless (record-caches database) (setf (record-caches database) - (make-hash-table :test 'equal - #+allegro :values #+allegro :weak - #+clisp :weak #+clisp :value - #+lispworks :weak-kind #+lispworks :value))) - (setf (gethash (compute-records-cache-key targets qualifiers) + (make-weak-hash-table :test 'equal))) + (setf (gethash (compute-records-cache-key (copy-list targets) qualifiers) (record-caches database)) results) results)