Author: lgiessmann Date: Mon Apr 5 16:15:44 2010 New Revision: 259 Log: new-datamodel: fixed a bug in the declaration of "defmethod for mark-as-deleted"; fixed a bug in "merge-constructs" for "TopicC" when both merged constructs are references to the same object. Modified: branches/new-datamodel/src/model/datamodel.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 Apr 5 16:15:44 2010 @@ -979,8 +979,8 @@ t))) -(defmethod marks-as-deleted ((construct VersionedConstructC) - &key source-locator revision) +(defmethod mark-as-deleted ((construct VersionedConstructC) + &key source-locator revision) (declare (ignorable source-locator)) (let ((last-version ;the last active version @@ -3462,22 +3462,24 @@ (defmethod merge-constructs ((construct-1 TopicC) (construct-2 TopicC) &key (revision *TM-REVISION*)) - (let ((older-topic (find-oldest-construct construct-1 construct-2))) - (let ((newer-topic (if (eql older-topic construct-1) - construct-2 - construct-1))) - (move-identifiers newer-topic older-topic :revision revision) - (dolist (tm (in-topicmaps newer-topic :revision revision)) - (add-to-tm tm older-topic)) - (move-names newer-topic older-topic :revision revision) - (move-occurrences newer-topic older-topic :revision revision) - (move-referenced-constructs newer-topic older-topic :revision revision) - (move-reified-construct newer-topic older-topic :revision revision) - (merge-changed-constructs older-topic :revision revision) - (mark-as-deleted newer-topic :revision revision) - (when (does-not-exist-in-revision-history newer-topic) - (delete-construct newer-topic)) - older-topic))) + (if (eql construct-1 construct-2) + construct-1 + (let ((older-topic (find-oldest-construct construct-1 construct-2))) + (let ((newer-topic (if (eql older-topic construct-1) + construct-2 + construct-1))) + (move-identifiers newer-topic older-topic :revision revision) + (dolist (tm (in-topicmaps newer-topic :revision revision)) + (add-to-tm tm older-topic)) + (move-names newer-topic older-topic :revision revision) + (move-occurrences newer-topic older-topic :revision revision) + (move-referenced-constructs newer-topic older-topic :revision revision) + (move-reified-construct newer-topic older-topic :revision revision) + (merge-changed-constructs older-topic :revision revision) + (mark-as-deleted newer-topic :revision revision) + (when (does-not-exist-in-revision-history newer-topic) + (delete-construct newer-topic)) + older-topic))))