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

[Lukas Giessmann]

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