Author: lgiessmann Date: Wed Mar 24 05:18:11 2010 New Revision: 250

Log: new-datamodel: added unit-tests for "make-conmstruct" --> "RoleC"; fixed 2 bugs in "make-role"

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 Wed Mar 24 05:18:11 2010 @@ -2767,7 +2767,7 @@ association)))

-(defun make-role (args) +(defun make-role (&rest args) "Returns a role object. If the role has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" @@ -2780,15 +2780,16 @@ (error "From make-role(): start-revision must be set")) (let ((role (let ((existing-role - (remove-if - #'null - (map 'list #'(lambda(existing-role) - (when (equivalent-construct - existing-role - :player player - :instance-of instance-of) - existing-role)) - (slot-p parent 'roles))))) + (when parent + (remove-if + #'null + (map 'list #'(lambda(existing-role) + (when (equivalent-construct + existing-role + :player player + :instance-of instance-of) + existing-role)) + (slot-p parent 'roles)))))) (if existing-role existing-role (make-instance 'RoleC)))))

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 Wed Mar 24 05:18:11 2010 @@ -68,7 +68,8 @@ :test-make-ItemIdentifierC :test-make-OccurrenceC :test-make-NameC - :test-make-VariantC)) + :test-make-VariantC + :test-make-RoleC))

;;TODO: test make-construct @@ -2219,6 +2220,50 @@ (is (eql variant-3 (find-item-by-revision variant-3 rev-1 name-1)))))))

+(test test-make-RoleC () + "Tests the function make-construct corresponding to RoleC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-0-5 50) + (rev-1 100) + (type-1 (make-instance 'TopicC)) + (ii-1 (make-instance 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'ItemIdentifierC :uri "ii-2")) + (player-1 (make-instance 'TopicC)) + (reifier-1 (make-instance 'TopicC)) + (assoc-1 (make-instance 'AssociationC))) + (setf *TM-REVISION* rev-1) + (let ((role-1 (make-construct 'RoleC)) + (role-2 (make-construct 'RoleC + :item-identifiers (list ii-1 ii-2) + :player player-1 + :reifier reifier-1 + :instance-of type-1 + :start-revision rev-1)) + (role-3 (make-construct 'RoleC + :parent assoc-1 + :start-revision rev-1))) + (signals error (make-construct 'RoleC + :item-identifiers (list ii-1))) + (signals error (make-construct 'RoleC :reifier reifier-1)) + (signals error (make-construct 'RoleC :parent assoc-1)) + (signals error (make-construct 'RoleC :instance-of type-1)) + (signals error (make-construct 'RoleC :player player-1)) + (is-false (item-identifiers role-1)) + (is-false (reifier role-1)) + (is-false (instance-of role-1)) + (is-false (parent role-1)) + (is-false (player role-1)) + (is-true (item-identifiers role-2)) + (is (= (length (union (list ii-1 ii-2) (item-identifiers role-2))) 2)) + (is (eql (reifier role-2) reifier-1)) + (is (eql (instance-of role-2) type-1)) + (is-false (parent role-2)) + (is (eql (player role-2) player-1)) + (is (eql ii-1 (find-item-by-revision ii-1 rev-1 role-2))) + (is-false (item-identifiers role-2 :revision rev-0-5)) + (is (eql (parent role-3) assoc-1)) + (is (eql role-3 (find-item-by-revision role-3 rev-1 assoc-1))))))) +

(defun run-datamodel-tests() @@ -2272,4 +2317,5 @@ (it.bese.fiveam:run! 'test-make-OccurrenceC) (it.bese.fiveam:run! 'test-make-NameC) (it.bese.fiveam:run! 'test-make-VariantC) + (it.bese.fiveam:run! 'test-make-RoleC) ) \ No newline at end of file