[isidorus-cvs] r203 - in branches/new-datamodel/src: model unit_tests

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Feb 23 14:49:01 2010
New Revision: 203

Log:
new-datamode: added some unit-tests for TopicIdentificationC; fixed some bugs related to TopicIdentifiecationC

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	Tue Feb 23 14:49:01 2010
@@ -773,26 +773,29 @@
   (:method ((construct TopicC) (topic-identifier TopicIdentificationC)
 	    &key (revision *TM-REVISION*))
     (let ((all-ids
-	   (map 'list #'identifier
-		(remove-if #'marked-as-deleted-p
-			   (slot-p construct 'topic-identifiers)))))
-      (cond ((find topic-identifier all-ids)
+	   (map 'list #'identifier (slot-p construct 'topic-identifiers)))
+	  (construct-to-be-merged
+	   (let ((id-owner (identified-construct topic-identifier)))
+	     (when (not (eql id-owner construct))
+	       id-owner))))
+      (cond (construct-to-be-merged
+	     (merge-constructs (identified-construct construct-to-be-merged
+						     :revision revision)
+			       construct))
+	    ((find topic-identifier all-ids)
 	     (let ((ti-assoc (loop for ti-assoc in (slot-p construct
 							   'topic-identifiers)
 				when (eql (identifier ti-assoc)
 					  topic-identifier)
 				return ti-assoc)))
 	       (add-to-version-history ti-assoc :start-revision revision)))
-	    (all-ids
-	     (merge-constructs (identified-construct (first all-ids)
-						     :revision revision)
-			       construct))
 	    (t
-	     (make-instance 'TopicIdAssociationC
-			    :start-revision revision
-			    :parent-construct construct
-			    :identifier topic-identifier)
-	     construct)))))
+	     (let ((assoc
+		    (make-instance 'TopicIdAssociationC
+				   :parent-construct construct
+				   :identifier topic-identifier)))
+	       (add-to-version-history assoc :start-revision revision))))
+      construct)))
 
 
 (defgeneric delete-topic-identifier (construct topic-identifier &key revision)

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	Tue Feb 23 14:49:01 2010
@@ -19,12 +19,14 @@
 	   :test-VersionedConstructC
 	   :test-ItemIdentifierC
 	   :test-PersistentIdC
-	   :test-SubjectLocatorC))
+	   :test-SubjectLocatorC
+	   :test-TopicIdentificationC))
 
 
 ;;TODO: test merges-constructs when merging was caused by an item-dentifier
 ;;TODO: test merges-constructs when merging was caused by an psi
 ;;TODO: test merges-constructs when merging was caused by an subject-locator
+;;TODO: test merges-constructs when merging was caused by a topic-id
 
 
 
@@ -246,10 +248,65 @@
 	(is-false (locators topic-1 :revision revision-3-5)))))
 
 
+(test test-TopicIdentificationC ()
+    "Tests various functions of the TopicIdentificationC class."
+    (with-fixture with-empty-db (*db-dir*)
+      (let ((ti-1 (make-instance 'TopicIdentificationC
+				 :uri "ti-1"
+				 :xtm-id "xtm-id-1"))
+	    (ti-2 (make-instance 'TopicIdentificationC
+				 :uri "ti-2"
+				 :xtm-id "xtm-id-2"))
+	    (topic-1 (make-instance '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 (identified-construct ti-1))
+	(signals error (make-instance 'TopicIdentificationC
+				      :uri "ti-1"))
+	(signals error (make-instance 'TopicIdentificationC
+				      :xtm-id "xtm-id-1"))
+	(is-false (topic-identifiers topic-1))
+	(add-topic-identifier topic-1 ti-1)
+	(is (= (length (topic-identifiers topic-1)) 1))
+	(is (eql (first (topic-identifiers topic-1)) ti-1))
+	(is (eql (identified-construct ti-1) topic-1))
+	(add-topic-identifier topic-1 ti-2 :revision revision-2)
+	(is (= (length (topic-identifiers topic-1 :revision revision-0)) 2))
+	(is (= (length (topic-identifiers topic-1 :revision revision-1)) 1))
+	(is (eql (first (topic-identifiers topic-1 :revision revision-1)) ti-1))
+	(is (= (length (union (list ti-1 ti-2)
+			      (topic-identifiers topic-1 :revision revision-2)))
+	       2))
+	(is (= (length (union (list ti-1 ti-2)
+			      (topic-identifiers topic-1 :revision revision-0)))
+	       2))
+	(delete-topic-identifier topic-1 ti-1 :revision revision-3)
+	(is (= (length (union (list ti-2)
+			      (topic-identifiers topic-1 :revision revision-0)))
+	       1))
+	(is (= (length (union (list ti-1 ti-2)
+			      (topic-identifiers topic-1 :revision revision-2)))
+	       2))
+	(delete-topic-identifier topic-1 ti-2 :revision revision-3)
+	(is-false (topic-identifiers topic-1 :revision revision-3))
+	(add-topic-identifier topic-1 ti-1 :revision revision-4)
+	(is (= (length (union (list ti-1)
+			      (topic-identifiers topic-1 :revision revision-0)))
+	       1))
+	(is (= (length (d::slot-p topic-1 'd::topic-identifiers)) 2))
+	(is-false (topic-identifiers topic-1 :revision revision-3-5)))))
+
+
 (defun run-datamodel-tests()
   (it.bese.fiveam:run! 'test-VersionInfoC)
   (it.bese.fiveam:run! 'test-VersionedConstructC)
   (it.bese.fiveam:run! 'test-ItemIdentifierC)
   (it.bese.fiveam:run! 'test-PersistentIdC)
   (it.bese.fiveam:run! 'test-SubjectLocatorC)
+  (it.bese.fiveam:run! 'test-TopicIdentificationC)
 )
\ No newline at end of file