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