Author: lgiessmann Date: Thu Apr 29 06:47:46 2010 New Revision: 291
Log: new-datamodel: fixed a bug when merging topics by adding an item-identifier to two different variants of the topic's names that are mergable
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 Thu Apr 29 06:47:46 2010 @@ -4101,7 +4101,10 @@ (find older-char (variants name :revision revision))) - (names active-parent :revision revision)))))) + (if (parent active-parent :revision revision) + (names (parent active-parent :revision revision) + :revision revision) + (list active-parent))))))) (if found-older-char older-char newer-char))))
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 Thu Apr 29 06:47:46 2010 @@ -89,13 +89,8 @@ :test-merge-constructs-TopicC-6 :test-merge-constructs-TopicC-7 :test-merge-constructs-TopicC-8 - :test-merge-constructs-TopicC-9)) - - -;;TODO: test merge-constructs --> associations when merge was caused by -;; item-identifier of two roles -;;TODO: test mark-as-deleted - + :test-merge-constructs-TopicC-9 + :test-merge-constructs-TopicC-10))
(declaim (optimize (debug 3))) @@ -3644,8 +3639,87 @@ (is-false (set-exclusive-or (list occ-2) (occurrences top-2))))))))
-;;TODO: merge topics caused by variant-item-identifiers -;;TODO: merge associations caused by a merge of their characteristics + +(test test-merge-constructs-TopicC-10 () + "Tests the generic move-referenced-constructs corresponding to TopicC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-1 100) + (rev-2 200) + (rev-3 300) + (psi-1 (make-construct 'PersistentIdC :uri "psi-1")) + (psi-2 (make-construct 'PersistentIdC :uri "psi-2")) + (ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2")) + (ii-3 (make-construct 'ItemIdentifierC :uri "ii-3")) + (ii-4 (make-construct 'ItemIdentifierC :uri "ii-4"))) + (let ((top-1 (make-construct 'TopicC + :start-revision rev-1 + :psis (list psi-1))) + (top-2 (make-construct 'TopicC + :start-revision rev-2 + :psis (list psi-2))) + (type-1 (make-construct 'TopicC :start-revision rev-1)) + (scope-1 (make-construct 'TopicC :start-revision rev-1))) + (let ((name-1 (make-construct 'NameC + :start-revision rev-1 + :instance-of nil + :charvalue "name" + :themes (list scope-1) + :item-identifiers (list ii-1) + :parent top-1)) + (name-2 (make-construct 'NameC + :start-revision rev-1 + :instance-of type-1 + :charvalue "name" + :themes (list scope-1) + :parent top-1)) + (name-3 (make-construct 'NameC + :start-revision rev-2 + :instance-of nil + :charvalue "name" + :themes (list scope-1) + :item-identifiers (list ii-2) + :parent top-2)) + (name-4 (make-construct 'NameC + :start-revision rev-2 + :instance-of type-1 + :charvalue "name" + :themes nil + :parent top-2))) + (let ((variant-1 (make-construct 'VariantC + :start-revision rev-1 + :charvalue "variant" + :themes (list scope-1) + :item-identifiers (list ii-3 ii-4) + :parent name-1)) + (variant-2 (make-construct 'VariantC + :start-revision rev-1 + :charvalue "variant" + :themes (list scope-1) + :parent name-4)) + (variant-3 (make-construct 'VariantC + :start-revision rev-2 + :charvalue "variant" + :themes (list scope-1) + :parent name-3))) + (setf *TM-REVISION* rev-3) + (signals not-mergable-error (add-item-identifier variant-2 ii-4)) + (is-false (marked-as-deleted-p top-2)) + (is-false (marked-as-deleted-p top-1)) + (is-false (marked-as-deleted-p name-4)) + (is (eql (add-item-identifier variant-3 ii-4) variant-1)) + (is-true (marked-as-deleted-p top-2)) + (is-false (names top-2)) + (is-false (psis top-2)) + (is-false (set-exclusive-or (list name-1 name-2 name-4) (names top-1))) + (is-false (set-exclusive-or (list psi-1 psi-2) (psis top-1))) + (is-false (set-exclusive-or (list variant-1) (variants name-1))) + (is-false (set-exclusive-or (list variant-2) (variants name-4))) + (is (= (length (d::versions top-1)) 2)))))))) + + + +;;TODO: merge associations caused by a merge of their roles
@@ -3717,4 +3791,5 @@ (it.bese.fiveam:run! 'test-merge-constructs-TopicC-7) (it.bese.fiveam:run! 'test-merge-constructs-TopicC-8) (it.bese.fiveam:run! 'test-merge-constructs-TopicC-9) + (it.bese.fiveam:run! 'test-merge-constructs-TopicC-10) ) \ No newline at end of file