Author: lgiessmann Date: Sun Mar 14 16:28:40 2010 New Revision: 226

Log: new-datamodel: added some unit-tests for equivalent-construct depending on PointerC

Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp

Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Mar 14 16:28:40 2010 @@ -1362,9 +1362,10 @@ (integer start-revision) (type (or null TopicC) instance-of reifier)) (or (and (string= (charvalue construct) charvalue) - (not (set-exclusive-or (themes construct :revision start-revision) - themes)) - (eql instance-of (instance-of construct :revision start-revision))) + (equivalent-scopable-construct construct themes + :start-revision start-revision) + (equivalent-typable-construct construct instance-of + :start-revision start-revision)) (equivalent-reifiable-construct construct reifier item-identifiers :start-revision start-revision)))

@@ -1542,9 +1543,10 @@ (or (and (not (set-exclusive-or roles (roles construct :revision start-revision))) - (eql instance-of (instance-of construct :revision start-revision)) - (not (set-exclusive-or themes - (themes construct :revision start-revision)))) + (equivalent-typable-construct construct instance-of + :start-revision start-revision) + (equivalent-scopable-construct construct themes + :start-revision start-revision)) (equivalent-reifiable-construct construct reifier item-identifiers :start-revision start-revision)))

@@ -1621,7 +1623,8 @@ (declare (integer start-revision) (type (or null TopicC) player instance-of reifier) (list item-identifiers)) - (or (and (eql instance-of (instance-of construct :revision start-revision)) + (or (and (equivalent-typable-construct construct instance-of + :start-revision start-revision) (eql player (player construct :revision start-revision))) (equivalent-reifiable-construct construct reifier item-identifiers :start-revision start-revision))) @@ -1886,8 +1889,25 @@ (mark-as-deleted assoc-to-delete :revision revision)) construct)))

+;;; TypableC +(defgeneric equivalent-typable-construct (construct instance-of + &key start-revision) + (:documentation "Returns t if the passed constructs are TMDM equal.") + (:method ((construct TypableC) instance-of &key (start-revision 0)) + (declare (integer start-revision) + (type (or null TopicC) instance-of)) + (eql (instance-of construct :revision start-revision) instance-of))) +

;;; ScopableC +(defgeneric equivalent-scopable-construct (construct themes &key start-revision) + (:documentation "Returns t if the passed constructs are TMDM equal.") + (:method ((construct ScopableC) themes &key (start-revision 0)) + (declare (integer start-revision) (list themes)) + (not (set-exclusive-or (themes construct :revision start-revision) + themes)))) + + (defmethod delete-construct :before ((construct ScopableC)) (dolist (scope-assoc-to-delete (slot-p construct 'themes)) (delete-construct scope-assoc-to-delete)))

Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Sun Mar 14 16:28:40 2010 @@ -47,7 +47,8 @@ :test-delete-TypableC :test-delete-ScopableC :test-delete-AssociationC - :test-delete-RoleC)) + :test-delete-RoleC + :test-equivalent-PointerC))

;;TODO: test merge-constructs when merging was caused by an item-dentifier, @@ -1337,6 +1338,24 @@ (is-false (elephant:get-instances-by-class 'd::PlayerAssociationC)))))

+(test test-equivalent-PointerC () + "Tests the functions equivalent-construct depending on PointerC + and its subclasses." + (with-fixture with-empty-db (*db-dir*) + (let ((p-1 (make-instance 'd::PointerC :uri "p-1")) + (tid-1 (make-instance 'd:TopicIdentificationC :uri "tid-1" + :xtm-id "xtm-1")) + (psi-1 (make-instance 'd:PersistentIdC :uri "psi-1"))) + (is-true (d::equivalent-construct p-1 :uri "p-1")) + (is-false (d::equivalent-construct p-1 :uri "p-2")) + (is-true (d::equivalent-construct tid-1 :uri "tid-1" :xtm-id "xtm-1")) + (is-false (d::equivalent-construct tid-1 :uri "tid-2" :xtm-id "xtm-1")) + (is-false (d::equivalent-construct tid-1 :uri "tid-1" :xtm-id "xtm-2")) + (is-false (d::equivalent-construct tid-1 :uri "tid-2" :xtm-id "xtm-2")) + (is-true (d::equivalent-construct psi-1 :uri "psi-1")) + (is-false (d::equivalent-construct psi-1 :uri "psi-2"))))) + + (defun run-datamodel-tests() "Runs all tests of this test-suite." (it.bese.fiveam:run! 'test-VersionInfoC) @@ -1369,4 +1388,5 @@ (it.bese.fiveam:run! 'test-delete-ScopableC) (it.bese.fiveam:run! 'test-delete-AssociationC) (it.bese.fiveam:run! 'test-delete-RoleC) + (it.bese.fiveam:run! 'test-equivalent-PointerC) ) \ No newline at end of file