Author: lgiessmann Date: Thu Apr 8 07:21:50 2010 New Revision: 269
Log: new-datamodel: fixed 2 bugs in "move-referenced-constructs" --> "ReifiableConstructC"
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 07:21:50 2010 @@ -3539,26 +3539,28 @@ (move-identifiers source destination :revision revision) (let ((source-reifier (reifier source :revision revision)) (destination-reifier (reifier destination :revision revision))) - (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))) - (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)))))) + (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)))))))
(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 07:21:50 2010 @@ -18,7 +18,8 @@ duplicate-identifier-error missing-argument-error tm-reference-error - object-not-found-error) + object-not-found-error + not-mergable-error) (:import-from :constants *xml-string* *xml-uri*) @@ -77,7 +78,8 @@ :test-make-TopicMapC :test-make-AssociationC :test-make-TopicC - :test-find-oldest-construct)) + :test-find-oldest-construct + :test-move-referenced-constructs-ReifiableConstructC))
;;TODO: test merge-constructs @@ -2787,6 +2789,53 @@ (is (eql tm-2 (d::find-oldest-construct tm-2 tm-1))))))
+(test test-move-referenced-constructs-ReifiableConstructC () + "Tests the generic move-referenced-constructs corresponding to ReifiableConstructC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-1 100) + (rev-2 200) + (ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2")) + (ii-3 (make-construct 'ItemIdentifierC :uri "ii-3"))) + (let ((reifier-1 (make-construct 'TopicC :start-revision rev-2)) + (reifier-2 (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)) + (type-1 (make-construct 'TopicC :start-revision rev-1)) + (type-2 (make-construct 'TopicC :start-revision rev-1))) + (let ((occ-1 (make-construct 'OccurrenceC + :start-revision rev-1 + :item-identifiers (list ii-1 ii-2) + :reifier reifier-1 + :instance-of type-2 + :themes (list theme-1 theme-2) + :charvalue "occ")) + (occ-2 (make-construct 'OccurrenceC + :start-revision rev-2 + :item-identifiers (list ii-3) + :charvalue "occ" + :instance-of type-1 + :themes (list theme-1 theme-2) + :reifier reifier-2))) + (setf *TM-REVISION* rev-1) + (delete-type occ-1 type-2 :revision rev-2) + (add-type occ-1 type-1 :revision rev-2) + (is (eql reifier-1 (reifier occ-1 :revision rev-2))) + (is (eql reifier-2 (reifier occ-2 :revision rev-2))) + (is (= (length (union (list ii-1 ii-2 reifier-2) + (d::move-referenced-constructs occ-1 occ-2 + :revision rev-2))) + 3)) + (is (= (length (item-identifiers occ-2 :revision rev-2)) 3)) + (is (= (length (union (item-identifiers occ-2 :revision rev-2) + (list ii-1 ii-2 ii-3))) + 3)) + (is-false (item-identifiers occ-1 :revision rev-2)) + (is-false (reifier occ-1 :revision rev-2)) + (is (eql (reifier occ-2 :revision rev-2) reifier-2)) + (is-true (d::marked-as-deleted-p reifier-1))))))) + +
(defun run-datamodel-tests() @@ -2845,4 +2894,5 @@ (it.bese.fiveam:run! 'test-make-AssociationC) (it.bese.fiveam:run! 'test-make-TopicC) (it.bese.fiveam:run! 'test-find-oldest-construct) + (it.bese.fiveam:run! 'test-move-referenced-constructs-ReifiableConstructC) ) \ No newline at end of file