Commit 657b84eb authored by ryszard.szopa's avatar ryszard.szopa
Browse files

bugfix in many-to-many definition+unit-tests.

darcs-hash:d559958191588620fee3a699a6100a8585f4e188
parent a0e44295
......@@ -211,12 +211,14 @@ be used to create the link table."
(mapcar #',class2-name (select-dao-fun ',table-name (list := ',class1-name (get-id object)))))
(defmethod ,class2-method-name ((object ,class2-name))
(mapcar #',class1-name (select-dao-fun ',table-name (list := ',class2-name (get-id object)))))
(defmethod relatedp-method ((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name '(eql name) 'null)))
(defmethod relatedp-method ((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name `(eql ',name) 'null)))
(select-dao-fun ',table-name `(and
(:= ,',class1-name ,(get-id object1))
(:= ,',class2-name ,(get-id object2)))))
(defmethod relatedp-method ((object2 ,class2-name) (object1 ,class1-name) relation)
(relatedp-method object1 object2 relation))
(defmethod relate-method
((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name '(eql name) 'null)) weight)
((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name `(eql ',name) 'null)) weight)
(let ((instance (make-instance ',table-name :weight weight)))
(setf (slot-value instance ',class1-name) object1)
(setf (slot-value instance ',class2-name) object2)
......@@ -225,8 +227,8 @@ be used to create the link table."
(defmethod relate-method ((object1 ,class2-name) (object2 ,class1-name) relation weight)
(relate-method object2 object1 relation weight))
(defmethod unrelate-method ((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name '(eql name) 'null)))
(delete-dao (car (relatedp object1 object2))))
(defmethod unrelate-method ((object1 ,class1-name) (object2 ,class2-name) (relation ,(if name `(eql ',name) 'null)))
(delete-dao (car (relatedp object1 object2 relation))))
(defmethod unrelate-method ((object2 ,class2-name) (object1 ,class1-name) relation)
(unrelate-method object1 object2 relation)))))
......@@ -256,6 +258,7 @@ assumed."
"Make a DAO and immediately save it. Takes the same arguments as
\(make-instance \(\(dao dao\)\)\)."
`(save-dao (make-instance ,type ,@rest)))
;;; Copyright (C) 2007
;;; Ryszard Szopa <ryszard.szopa@gmail.com> &
;;; Streamtech http://streamtech.nl/
......
......@@ -101,6 +101,31 @@ metaclass set to HTML and the right connection-spec."
((bar :type integer)))
(defmany foo bar)))
(db-test (named-many-to-many-definition :depends-on many-to-many-definition)
(defdao-example foo ()
((foo :type integer)))
(defdao-example bar ()
((bar :type integer)))
(finishes (defmany foo bar :name barfoo)))
(db-test (named-many-to-many :depends-on named-many-to-many-definition)
(defdao-example foo ()
())
(defdao-example bar ()
())
(defmany foo bar :name barfoo-1)
(defmany foo bar :name barfoo-2)
(let ((bar (make-and-save 'bar))
(foo (make-and-save 'foo))
(foo2 (make-and-save 'foo)))
(relate bar foo :relation 'barfoo-1)
(relate bar foo2 :relation 'barfoo-2)
(is (relatedp foo bar 'barfoo-1))
(is-false (relatedp bar foo2 'barfoo-1))
(is (relatedp bar foo2 'barfoo-2))
(unrelate bar foo2 :relation 'barfoo-2)
(is-false (relatedp foo2 bar 'barfoo-2))))
(db-test (many-to-many-redefinition :depends-on many-to-many-definition)
(finishes
(defdao-example foo ()
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment