Patch for :target-slot in oodml.list
Drew Crampsie <[email protected]> Thu, 27 Oct 2005 13:17:20 -0700
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Message-ID | <[email protected]> |
I was trying to use the target-slot attribute, but noticed that it did not work if the slot name differed from the name of the class it pointing to. In other words, the code neglected to find the :join-class in the target slot definition, rather just assuming that the slot name also named the class. This broke for my purposes. I have included a patch that fixes this, and can provide an example of the code that broke with the original behaviour if my explanation was not clear enough (it's late and i'm tired). cheers, drewc _______________________________________________ CLSQL-Devel mailing list [email protected] http://lists.b9.com/mailman/listinfo/clsql-devel
oodml.patch
(text/plain, 1.5 KB)
--- sql/oodml.lisp 2005-09-17 17:13:12.000000000 -0700
+++ /home/drewc/oodml.lisp 2005-10-26 20:59:27.491098112 -0700
@@ -627,21 +627,23 @@
(defun fault-join-target-slot (class object slot-def)
(let* ((dbi (view-class-slot-db-info slot-def))
- (ts (gethash :target-slot dbi))
- (jc (gethash :join-class dbi))
- (ts-view-table (view-table (find-class ts)))
+ (ts (gethash :target-slot dbi))
+ (jc (gethash :join-class dbi))
(jc-view-table (view-table (find-class jc)))
(tdbi (view-class-slot-db-info
- (find ts (class-slots (find-class jc))
- :key #'slot-definition-name)))
+ (find ts (class-slots (find-class jc))
+ :key #'slot-definition-name)))
(retrieval (gethash :retrieval tdbi))
+ (tsc (gethash :join-class tdbi))
+ (ts-view-table (view-table (find-class tsc)))
(jq (join-qualifier class object slot-def))
(key (slot-value object (gethash :home-key dbi))))
+
(when jq
(ecase retrieval
(:immediate
(let ((res
- (find-all (list ts)
+ (find-all (list tsc)
:inner-join (sql-expression :table jc-view-table)
:on (sql-operation
'==
@@ -667,7 +669,7 @@
;; just fill in minimal slots
(mapcar
#'(lambda (k)
- (let ((instance (make-instance ts :view-database (view-database object)))
+ (let ((instance (make-instance tsc :view-database (view-database object)))
(jcc (make-instance jc :view-database (view-database object)))
(fk (car k)))
(setf (slot-value instance (gethash :home-key tdbi)) fk)