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

[Lukas Giessmann]

Author: lgiessmann
Date: Wed Mar 24 05:47:39 2010
New Revision: 251

Log:
new-datamodel: added unit-tests for "make-construct" --> "TopicMapC"; fixed a parameter bug in "make-tm" and "make-association"

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:47:39 2010
@@ -2736,7 +2736,7 @@
 	construct)))
 
 
-(defun make-association (args)
+(defun make-association (&rest args)
   "Returns an association object. If the association has already existed the
    existing one is returned otherwise a new one is created.
    This function exists only for being used by make-construct!"
@@ -2800,7 +2800,7 @@
       role)))
 
 
-(defun make-tm (args)
+(defun make-tm (&rest args)
   "Returns a topic map object. If the topic map has already existed the
    existing one is returned otherwise a new one is created.
    This function exists only for being used by make-construct!"

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:47:39 2010
@@ -69,7 +69,8 @@
 	   :test-make-OccurrenceC
 	   :test-make-NameC
 	   :test-make-VariantC
-	   :test-make-RoleC))
+	   :test-make-RoleC
+	   :test-make-TopicMapC))
 
 
 ;;TODO: test make-construct
@@ -2266,6 +2267,64 @@
 
 
 
+(test test-make-TopicMapC ()
+  "Tests the function make-construct corresponding to TopicMapC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-1 100)
+	  (top-1 (make-instance 'TopicC))
+	  (top-2 (make-instance 'TopicC))
+	  (top-3 (make-instance 'TopicC))
+	  (assoc-1 (make-instance 'AssociationC))
+	  (assoc-2 (make-instance 'AssociationC))
+	  (assoc-3 (make-instance 'AssociationC))
+	  (ii-1 (make-instance 'ItemIdentifierC :uri "ii-1"))
+	  (ii-2 (make-instance 'ItemIdentifierC :uri "ii-2"))
+	  (ii-3 (make-instance 'ItemIdentifierC :uri "ii-3"))
+	  (ii-4 (make-instance 'ItemIdentifierC :uri "ii-4"))
+	  (reifier-1 (make-instance 'TopicC)))
+      (let ((tm-1 (make-construct 'TopicMapC
+				  :start-revision rev-1
+				  :topics (list top-1 top-2)
+				  :associations (list assoc-1 assoc-2)
+				  :item-identifiers (list ii-1 ii-2)
+				  :reifier reifier-1))
+	    (tm-2 (make-construct 'TopicMapC
+				  :start-revision rev-1
+				  :item-identifiers (list ii-3))))
+	(signals error (make-construct 'TopicMapC))
+	(is (eql (reifier tm-1) reifier-1))
+	(is (= (length (item-identifiers tm-1)) 2))
+	(is (= (length (union (item-identifiers tm-1) (list ii-1 ii-2))) 2))
+	(is (= (length (topics tm-1)) 2))
+	(is (= (length (union (topics tm-1) (list top-1 top-2))) 2))
+	(is (= (length (associations tm-1)) 2))
+	(is (= (length (union (associations tm-1) (list assoc-1 assoc-2))) 2))
+	(is (eql (find-item-by-revision tm-1 rev-1) tm-1))
+	(is (= (length (item-identifiers tm-2)) 1))
+	(is (= (length (union (item-identifiers tm-2) (list ii-3))) 1))
+	(is-false (topics tm-2))
+	(is-false (associations tm-2))
+	(is-false (reifier tm-2))
+	(let ((tm-3 (make-construct 'TopicMapC
+				    :start-revision rev-1
+				    :topics (list top-3)
+				    :associations (list assoc-3)
+				    :item-identifiers (list ii-2 ii-4))))
+	  (is (eql (reifier tm-3) reifier-1))
+	  (is (= (length (item-identifiers tm-3)) 3))
+	  (is (= (length (union (item-identifiers tm-3) (list ii-1 ii-2 ii-4)))
+		 3))
+	  (is (= (length (topics tm-3)) 3))
+	  (is (= (length (union (topics tm-3) (list top-1 top-2 top-3))) 3))
+	  (is (= (length (associations tm-3)) 3))
+	  (is (= (length (union (associations tm-3)
+				(list assoc-1 assoc-2 assoc-3)))
+		 3))
+	  (is (eql (find-item-by-revision tm-3 rev-1) tm-3)))))))
+
+
+
+
 (defun run-datamodel-tests()
   "Runs all tests of this test-suite."
   (it.bese.fiveam:run! 'test-VersionInfoC)
@@ -2318,4 +2377,5 @@
   (it.bese.fiveam:run! 'test-make-NameC)
   (it.bese.fiveam:run! 'test-make-VariantC)
   (it.bese.fiveam:run! 'test-make-RoleC)
+  (it.bese.fiveam:run! 'test-make-TopicMapC)
   )
\ No newline at end of file