Author: lgiessmann Date: Thu Apr 8 11:00:35 2010 New Revision: 270 Log: new-datamodel: modified "move-referenced-constructs" --> "NameC"; added some unti-tests 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 8 11:00:35 2010 @@ -3539,28 +3539,30 @@ (move-identifiers source destination :revision revision) (let ((source-reifier (reifier source :revision revision)) (destination-reifier (reifier destination :revision revision))) - (list - (cond ((and source-reifier destination-reifier) - (delete-reifier (reified-construct source-reifier - :revision revision) - source-reifier :revision revision) - (delete-reifier (reified-construct destination-reifier - :revision revision) - destination-reifier :revision revision) - (let ((merged-reifier - (merge-constructs source-reifier destination-reifier - :revision revision))) - (add-reifier destination merged-reifier :revision revision) - merged-reifier)) - (source-reifier - (delete-reifier (reified-construct source-reifier - :revision revision) - source-reifier :revision revision) - (add-reifier destination source-reifier :revision revision) - source-reifier) - (destination-reifier - (add-reifier destination destination-reifier :revision revision) - destination-reifier))))))) + (let ((result + (cond ((and source-reifier destination-reifier) + (delete-reifier (reified-construct source-reifier + :revision revision) + source-reifier :revision revision) + (delete-reifier (reified-construct destination-reifier + :revision revision) + destination-reifier :revision revision) + (let ((merged-reifier + (merge-constructs source-reifier destination-reifier + :revision revision))) + (add-reifier destination merged-reifier :revision revision) + merged-reifier)) + (source-reifier + (delete-reifier (reified-construct source-reifier + :revision revision) + source-reifier :revision revision) + (add-reifier destination source-reifier :revision revision) + source-reifier) + (destination-reifier + (add-reifier destination destination-reifier :revision revision) + nil)))) + (when result + (list result))))))) (defmethod move-referenced-constructs ((source NameC) (destination NameC) 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 8 11:00:35 2010 @@ -79,7 +79,8 @@ :test-make-AssociationC :test-make-TopicC :test-find-oldest-construct - :test-move-referenced-constructs-ReifiableConstructC)) + :test-move-referenced-constructs-ReifiableConstructC + :test-move-referenced-constructs-NameC)) ;;TODO: test merge-constructs @@ -2836,6 +2837,86 @@ (is-true (d::marked-as-deleted-p reifier-1))))))) +(test test-move-referenced-constructs-NameC () + "Tests the generic move-referenced-constructs corresponding to NameC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-1 100) + (rev-2 200)) + (let ((ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2")) + (reifier-1 (make-construct 'TopicC :start-revision rev-1)) + (reifier-2 (make-construct 'TopicC :start-revision rev-2)) + (type-1 (make-construct 'TopicC :start-revision rev-1)) + (theme-1 (make-construct 'TopicC :start-revision rev-1)) + (theme-2 (make-construct 'TopicC :start-revision rev-1))) + (let ((variant-1 (make-construct 'VariantC + :start-revision rev-1 + :themes (list theme-1) + :charvalue "var-1" + :item-identifiers (list ii-1) + :reifier reifier-2)) + (variant-2 (make-construct 'VariantC + :start-revision rev-1 + :themes (list theme-1) + :charvalue "var-2+4")) + (variant-3 (make-construct 'VariantC + :start-revision rev-1 + :themes (list theme-2) + :charvalue "var-3")) + (variant-4 (make-construct 'VariantC + :start-revision rev-1 + :themes (list theme-1) + :charvalue "var-2+4"))) + (let ((name-1 (make-construct 'NameC + :start-revision rev-1 + :charvalue "name" + :variants (list variant-1 variant-2) + :instance-of type-1 + :item-identifiers (list ii-2))) + (name-2 (make-construct 'NameC + :start-revision rev-1 + :charvalue "name" + :variants (list variant-3 variant-4) + :instance-of type-1 + :reifier reifier-1))) + (setf *TM-REVISION* rev-1) + (is (= (length (union (list variant-1 variant-2) + (variants name-1))) 2)) + (is (= (length (union (list variant-3 variant-4) + (variants name-2))) 2)) + (is-false (reifier name-1)) + (is (eql reifier-1 (reifier name-2))) + (is (= (length + (union (list variant-1 variant-2 ii-2) + (d::move-referenced-constructs name-1 name-2 + :revision rev-2))) + 3)) + (is-false (item-identifiers name-1 :revision rev-2)) + (is-false (reifier name-1 :revision rev-2)) + (is-false (variants name-1 :revision rev-2)) + (is (= (length (item-identifiers name-2 :revision rev-2)) 1)) + (is (= (length (union (list ii-2) + (item-identifiers name-2 :revision rev-2))) + 1)) + (is (eql (reifier name-2 :revision rev-2) reifier-1)) + (is (= (length (variants name-2 :revision rev-2)) 3)) + (is (= (length (union (list variant-1 variant-3 variant-4) + (variants name-2 :revision rev-2))) + 3)) + (is-true + (find-if + #'(lambda(var) + (and (= (length (item-identifiers var :revision rev-2)) 1) + (string= (uri (first (item-identifiers var + :revision rev-2))) + "ii-1"))) + (variants name-2 :revision rev-2))) + (is-true + (find-if #'(lambda(var) + (eql (reifier var :revision rev-2) reifier-2)) + (variants name-2 :revision rev-2))))))))) + + (defun run-datamodel-tests() @@ -2895,4 +2976,5 @@ (it.bese.fiveam:run! 'test-make-TopicC) (it.bese.fiveam:run! 'test-find-oldest-construct) (it.bese.fiveam:run! 'test-move-referenced-constructs-ReifiableConstructC) + (it.bese.fiveam:run! 'test-move-referenced-constructs-NameC) ) \ No newline at end of file