Author: lgiessmann Date: Tue Feb 23 14:49:01 2010 New Revision: 203 Log: new-datamode: added some unit-tests for TopicIdentificationC; fixed some bugs related to TopicIdentifiecationC 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 Tue Feb 23 14:49:01 2010 @@ -773,26 +773,29 @@ (:method ((construct TopicC) (topic-identifier TopicIdentificationC) &key (revision *TM-REVISION*)) (let ((all-ids - (map 'list #'identifier - (remove-if #'marked-as-deleted-p - (slot-p construct 'topic-identifiers))))) - (cond ((find topic-identifier all-ids) + (map 'list #'identifier (slot-p construct 'topic-identifiers))) + (construct-to-be-merged + (let ((id-owner (identified-construct topic-identifier))) + (when (not (eql id-owner construct)) + id-owner)))) + (cond (construct-to-be-merged + (merge-constructs (identified-construct construct-to-be-merged + :revision revision) + construct)) + ((find topic-identifier all-ids) (let ((ti-assoc (loop for ti-assoc in (slot-p construct 'topic-identifiers) when (eql (identifier ti-assoc) topic-identifier) return ti-assoc))) (add-to-version-history ti-assoc :start-revision revision))) - (all-ids - (merge-constructs (identified-construct (first all-ids) - :revision revision) - construct)) (t - (make-instance 'TopicIdAssociationC - :start-revision revision - :parent-construct construct - :identifier topic-identifier) - construct))))) + (let ((assoc + (make-instance 'TopicIdAssociationC + :parent-construct construct + :identifier topic-identifier))) + (add-to-version-history assoc :start-revision revision)))) + construct))) (defgeneric delete-topic-identifier (construct topic-identifier &key revision) 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 Tue Feb 23 14:49:01 2010 @@ -19,12 +19,14 @@ :test-VersionedConstructC :test-ItemIdentifierC :test-PersistentIdC - :test-SubjectLocatorC)) + :test-SubjectLocatorC + :test-TopicIdentificationC)) ;;TODO: test merges-constructs when merging was caused by an item-dentifier ;;TODO: test merges-constructs when merging was caused by an psi ;;TODO: test merges-constructs when merging was caused by an subject-locator +;;TODO: test merges-constructs when merging was caused by a topic-id @@ -246,10 +248,65 @@ (is-false (locators topic-1 :revision revision-3-5))))) +(test test-TopicIdentificationC () + "Tests various functions of the TopicIdentificationC class." + (with-fixture with-empty-db (*db-dir*) + (let ((ti-1 (make-instance 'TopicIdentificationC + :uri "ti-1" + :xtm-id "xtm-id-1")) + (ti-2 (make-instance 'TopicIdentificationC + :uri "ti-2" + :xtm-id "xtm-id-2")) + (topic-1 (make-instance 'TopicC)) + (revision-0 0) + (revision-1 100) + (revision-2 200) + (revision-3 300) + (revision-3-5 350) + (revision-4 400)) + (setf d:*TM-REVISION* revision-1) + (is-false (identified-construct ti-1)) + (signals error (make-instance 'TopicIdentificationC + :uri "ti-1")) + (signals error (make-instance 'TopicIdentificationC + :xtm-id "xtm-id-1")) + (is-false (topic-identifiers topic-1)) + (add-topic-identifier topic-1 ti-1) + (is (= (length (topic-identifiers topic-1)) 1)) + (is (eql (first (topic-identifiers topic-1)) ti-1)) + (is (eql (identified-construct ti-1) topic-1)) + (add-topic-identifier topic-1 ti-2 :revision revision-2) + (is (= (length (topic-identifiers topic-1 :revision revision-0)) 2)) + (is (= (length (topic-identifiers topic-1 :revision revision-1)) 1)) + (is (eql (first (topic-identifiers topic-1 :revision revision-1)) ti-1)) + (is (= (length (union (list ti-1 ti-2) + (topic-identifiers topic-1 :revision revision-2))) + 2)) + (is (= (length (union (list ti-1 ti-2) + (topic-identifiers topic-1 :revision revision-0))) + 2)) + (delete-topic-identifier topic-1 ti-1 :revision revision-3) + (is (= (length (union (list ti-2) + (topic-identifiers topic-1 :revision revision-0))) + 1)) + (is (= (length (union (list ti-1 ti-2) + (topic-identifiers topic-1 :revision revision-2))) + 2)) + (delete-topic-identifier topic-1 ti-2 :revision revision-3) + (is-false (topic-identifiers topic-1 :revision revision-3)) + (add-topic-identifier topic-1 ti-1 :revision revision-4) + (is (= (length (union (list ti-1) + (topic-identifiers topic-1 :revision revision-0))) + 1)) + (is (= (length (d::slot-p topic-1 'd::topic-identifiers)) 2)) + (is-false (topic-identifiers topic-1 :revision revision-3-5))))) + + (defun run-datamodel-tests() (it.bese.fiveam:run! 'test-VersionInfoC) (it.bese.fiveam:run! 'test-VersionedConstructC) (it.bese.fiveam:run! 'test-ItemIdentifierC) (it.bese.fiveam:run! 'test-PersistentIdC) (it.bese.fiveam:run! 'test-SubjectLocatorC) + (it.bese.fiveam:run! 'test-TopicIdentificationC) ) \ No newline at end of file