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

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Apr  8 07:21:50 2010
New Revision: 269

Log:
new-datamodel: fixed 2 bugs in "move-referenced-constructs" --> "ReifiableConstructC"

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	Thu Apr  8 07:21:50 2010
@@ -3539,26 +3539,28 @@
     (move-identifiers source destination :revision revision)
     (let ((source-reifier (reifier source :revision revision))
 	  (destination-reifier (reifier destination :revision revision)))
-      (cond ((and source-reifier destination-reifier)
-	     (delete-reifier (reified-construct source-reifier
-						:revision revision)
-			     source-reifier :revision revision)
-	     (delete-reifier (reified-construct destination-reifier
-						:revision revision)
-			     destination-reifier :revision revision)
-	     (let ((merged-reifier
-		    (merge-constructs source-reifier destination-reifier
-				      :revision revision)))
-	       (add-reifier destination merged-reifier :revision revision)))
-	    (source-reifier
-	     (delete-reifier (reified-construct source-reifier
-						:revision revision)
-			     source-reifier :revision revision)
-	     (add-reifier destination source-reifier :revision revision)
-	     source-reifier)
-	    (destination-reifier
-	     (add-reifier destination destination-reifier :revision revision)
-	     destination-reifier))))))
+      (list
+       (cond ((and source-reifier destination-reifier)
+	      (delete-reifier (reified-construct source-reifier
+						 :revision revision)
+			      source-reifier :revision revision)
+	      (delete-reifier (reified-construct destination-reifier
+						 :revision revision)
+			      destination-reifier :revision revision)
+	      (let ((merged-reifier
+		     (merge-constructs source-reifier destination-reifier
+				       :revision revision)))
+		(add-reifier destination merged-reifier :revision revision)
+		merged-reifier))
+	     (source-reifier
+	      (delete-reifier (reified-construct source-reifier
+						 :revision revision)
+			      source-reifier :revision revision)
+	      (add-reifier destination source-reifier :revision revision)
+	      source-reifier)
+	     (destination-reifier
+	      (add-reifier destination destination-reifier :revision revision)
+	      destination-reifier)))))))
 
 
 (defmethod move-referenced-constructs ((source NameC) (destination NameC)

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	Thu Apr  8 07:21:50 2010
@@ -18,7 +18,8 @@
 		duplicate-identifier-error
 		missing-argument-error
 		tm-reference-error
-		object-not-found-error)
+		object-not-found-error
+		not-mergable-error)
   (:import-from :constants
 		*xml-string*
 		*xml-uri*)
@@ -77,7 +78,8 @@
 	   :test-make-TopicMapC
 	   :test-make-AssociationC
 	   :test-make-TopicC
-	   :test-find-oldest-construct))
+	   :test-find-oldest-construct
+	   :test-move-referenced-constructs-ReifiableConstructC))
 
 
 ;;TODO: test merge-constructs
@@ -2787,6 +2789,53 @@
       (is (eql tm-2 (d::find-oldest-construct tm-2 tm-1))))))
 
 
+(test test-move-referenced-constructs-ReifiableConstructC ()
+  "Tests the generic move-referenced-constructs corresponding to ReifiableConstructC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-1 100)
+	  (rev-2 200)
+	  (ii-1 (make-construct 'ItemIdentifierC :uri "ii-1"))
+	  (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2"))
+	  (ii-3 (make-construct 'ItemIdentifierC :uri "ii-3")))
+      (let ((reifier-1 (make-construct 'TopicC :start-revision rev-2))
+	    (reifier-2 (make-construct 'TopicC :start-revision rev-1))
+	    (theme-1 (make-construct 'TopicC :start-revision rev-1))
+	    (theme-2 (make-construct 'TopicC :start-revision rev-1))
+	    (type-1 (make-construct 'TopicC :start-revision rev-1))
+	    (type-2 (make-construct 'TopicC :start-revision rev-1)))
+	(let ((occ-1 (make-construct 'OccurrenceC
+				     :start-revision rev-1
+				     :item-identifiers (list ii-1 ii-2)
+				     :reifier reifier-1
+				     :instance-of type-2
+				     :themes (list theme-1 theme-2)
+				     :charvalue "occ"))
+	      (occ-2 (make-construct 'OccurrenceC
+				     :start-revision rev-2
+				     :item-identifiers (list ii-3)
+				     :charvalue "occ"
+				     :instance-of type-1
+				     :themes (list theme-1 theme-2)
+				     :reifier reifier-2)))
+	  (setf *TM-REVISION* rev-1)
+	  (delete-type occ-1 type-2 :revision rev-2)
+	  (add-type occ-1 type-1 :revision rev-2)
+	  (is (eql reifier-1 (reifier occ-1 :revision rev-2)))
+	  (is (eql reifier-2 (reifier occ-2 :revision rev-2)))
+	  (is (= (length (union (list ii-1 ii-2 reifier-2)
+				(d::move-referenced-constructs occ-1 occ-2
+							       :revision rev-2)))
+		 3))
+	  (is (= (length (item-identifiers occ-2 :revision rev-2)) 3))
+	  (is (= (length (union (item-identifiers occ-2 :revision rev-2)
+				(list ii-1 ii-2 ii-3)))
+		 3))
+	  (is-false (item-identifiers occ-1 :revision rev-2))
+	  (is-false (reifier occ-1 :revision rev-2))
+	  (is (eql (reifier occ-2 :revision rev-2) reifier-2))
+	  (is-true (d::marked-as-deleted-p reifier-1)))))))
+
+
 
 
 (defun run-datamodel-tests()
@@ -2845,4 +2894,5 @@
   (it.bese.fiveam:run! 'test-make-AssociationC)
   (it.bese.fiveam:run! 'test-make-TopicC)
   (it.bese.fiveam:run! 'test-find-oldest-construct)
+  (it.bese.fiveam:run! 'test-move-referenced-constructs-ReifiableConstructC)
   )
\ No newline at end of file