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

[Lukas Giessmann]

Author: lgiessmann
Date: Sat Feb 27 05:43:01 2010
New Revision: 216

Log:
new-datamodel: added some unit-tests for the class RoleC --> player handling.

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	Sat Feb 27 05:43:01 2010
@@ -1524,24 +1524,29 @@
   (:documentation "Adds a topic as a player to a role in the given revision.")
   (:method ((construct RoleC) (player-topic TopicC)
 	    &key (revision *TM-REVISION*))
-    (let ((already-set-player (player construct :revision revision)))
-      ;;TODO: search a player-assoc for the passed construct that was set in an older version
-      (cond ((and already-set-player
-		  (eql (first already-set-player) player-topic))
+    (let ((already-set-player (player construct :revision revision))
+	  (same-player-assoc
+	   (loop for player-assoc in (slot-p construct 'player)
+	      when (eql (player-topic player-assoc) player-topic)
+	      return player-assoc)))
+      (when (and already-set-player
+		 (not (eql already-set-player player-topic)))
+	(error "From add-player(): ~a can't be palyed by ~a since it is played by ~a"
+	       construct player-topic already-set-player))
+      (cond (already-set-player
 	     (let ((player-assoc
 		    (loop for player-assoc in (slot-p construct 'player)
 		       when (eql player-topic (player-topic player-assoc))
 		       return player-assoc)))
 	       (add-to-version-history player-assoc :start-revision revision)))
-	    ((not already-set-player)
+	    (same-player-assoc
+	     (add-to-version-history same-player-assoc :start-revision revision))
+	    (t
 	     (let ((assoc (make-instance 'PlayerAssociationC
 					 :parent-construct construct
 					 :player-topic player-topic)))
-	       (add-to-version-history assoc :start-revision revision)))
-	    (t
-	     (error "From add-player(): ~a can't be a player of ~a since it has already the player ~a"
-		    player-topic construct already-set-player)))
-      construct)))
+	       (add-to-version-history assoc :start-revision revision)))))
+    construct))
 
 
 (defgeneric delete-player (construct player-topic &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	Sat Feb 27 05:43:01 2010
@@ -34,7 +34,8 @@
 	   :test-NameC
 	   :test-TypableC
 	   :test-ScopableC
-	   :test-RoleC))
+	   :test-RoleC
+	   :test-player))
 
 
 ;;TODO: test delete-construct
@@ -828,6 +829,45 @@
       (is (= (length (slot-value assoc-2 'roles)) 2))
       (is (= (length (slot-value role-1 'parent)) 2))
       (is (= (length (slot-value role-2 'parent)) 2)))))
+
+
+(test test-player ()
+  "Tests various functions of the topics that are used as player in roles."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((role-1 (make-instance 'RoleC))
+	  (role-2 (make-instance 'RoleC))
+	  (top-1 (make-instance 'TopicC))
+	  (top-2 (make-instance 'TopicC))
+	  (revision-0-5 50)
+	  (revision-1 100)
+	  (revision-2 200)
+	  (revision-3 300))
+      (setf *TM-REVISION* revision-1)
+      (is-false (player role-1))
+      (add-player role-1 top-1)
+      (is (eql top-1 (player role-1)))
+      (is-false (player role-1 :revision revision-0-5))
+      (is (eql top-1 (player role-1 :revision revision-2)))
+      (add-player role-1 top-1)
+      (is (eql top-1 (player role-1)))
+      (is-false (player role-1 :revision revision-0-5))
+      (is (eql top-1 (player role-1 :revision revision-2)))
+      (signals error (add-player role-1 top-2))
+      (add-player role-2 top-1 :revision revision-2)
+      (is (= (length (union (list role-1 role-2)
+			    (player-in-roles top-1))) 2))
+      (is (= (length (union (list role-1)
+			    (player-in-roles top-1
+					  :revision revision-1))) 1))
+      (delete-player role-1 top-1 :revision revision-3)
+      (is-false (player role-1))
+      (is (= (length (union (list role-2)
+			    (player-in-roles top-1))) 1))
+      (add-player role-1 top-1 :revision revision-3)
+      (is (eql top-1 (player role-1)))
+      (is (= (length (union (list role-1 role-2)
+			    (player-in-roles top-1))) 2))
+      (is (= (length (slot-value top-1 'd::player-in-roles)) 2)))))
       
 
 
@@ -849,4 +889,5 @@
   (it.bese.fiveam:run! 'test-TypableC)
   (it.bese.fiveam:run! 'test-ScopableC)
   (it.bese.fiveam:run! 'test-RoleC)
+  (it.bese.fiveam:run! 'test-player)
 )
\ No newline at end of file