[isidorus-cvs] r259 - branches/new-datamodel/src/model

[Lukas Giessmann]

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))))