Author: lgiessmann Date: Mon Feb 22 14:55:40 2010 New Revision: 201 Log: new-datamodel: fixed some bugs in item-identifiers, add-item-identifier and delete-item-identifier; added a unit-test for item-identifiers 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 Mon Feb 22 14:55:40 2010 @@ -1508,17 +1508,19 @@ (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC) &key (revision *TM-REVISION*)) (let ((all-ids - (map 'list #'identifier - (remove-if #'marked-as-deleted-p - (slot-p construct 'item-identifiers))))) + (map 'list #'identifier (slot-p construct 'item-identifiers))) + (construct-to-be-merged + (let ((id-owner (identified-construct item-identifier))) + (when (not (eql id-owner construct)) + id-owner)))) (cond ((find item-identifier all-ids) (let ((ii-assoc (loop for ii-assoc in (slot-p construct 'item-identifiers) when (eql (identifier ii-assoc) item-identifier) return ii-assoc))) (add-to-version-history ii-assoc :start-revision revision))) - (all-ids - (merge-constructs (identified-construct (first all-ids) + (construct-to-be-merged + (merge-constructs (identified-construct construct-to-be-merged :revision revision) construct)) (t 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 Mon Feb 22 14:55:40 2010 @@ -97,19 +97,52 @@ (test test-ItemIdentifierC () "Tests various functions of the VersionedCoinstructC class." (with-fixture with-empty-db (*db-dir*) - (setf d:*TM-REVISION* 100) (let ((ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) - (topic (make-instance 'd:TopicC))) + (topic-1 (make-instance 'd: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 (d:identified-construct ii-1)) (signals error (make-instance 'd:ItemIdentifierC)) - (is-false (item-identifiers topic)) - (d:add-item-identifier topic ii-1) - (format t ">>> ~a~%" (d::parent-construct ii-1)) - (is (= (length (d:item-identifiers topic)) 1)) - ))) + (is-false (item-identifiers topic-1)) + (d:add-item-identifier topic-1 ii-1) + (is (= (length (item-identifiers topic-1)) 1)) + (is (eql (first (item-identifiers topic-1)) ii-1)) + (is (eql (identified-construct ii-1) topic-1)) + (d:add-item-identifier topic-1 ii-2 :revision revision-2) + (is (= (length (item-identifiers topic-1 :revision revision-0)) 2)) + (is (= (length (item-identifiers topic-1 :revision revision-1)) 1)) + (is (eql (first (item-identifiers topic-1 :revision revision-1)) ii-1)) + (is (= (length (union (list ii-1 ii-2) + (item-identifiers topic-1 :revision revision-2))) + 2)) + (is (= (length (union (list ii-1 ii-2) + (item-identifiers topic-1 :revision revision-0))) + 2)) + (delete-item-identifier topic-1 ii-1 :revision revision-3) + (is (= (length (union (list ii-2) + (d:item-identifiers topic-1 + :revision revision-0))) + 1)) + (is (= (length (union (list ii-1 ii-2) + (d:item-identifiers topic-1 + :revision revision-2))) + 2)) + (delete-item-identifier topic-1 ii-2 :revision revision-3) + (is-false (item-identifiers topic-1 :revision revision-3)) + (add-item-identifier topic-1 ii-1 :revision revision-4) + (is (= (length (union (list ii-1) + (item-identifiers topic-1 :revision revision-0))) + 1)) + (is (= (length (d::slot-p topic-1 'd::item-identifiers)) 2)) + (is-false (item-identifiers topic-1 :revision revision-3-5))))) (defun run-datamodel-tests()