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

[Lukas Giessmann]

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