[isidorus-cvs] r253 - branches/new-datamodel/src/unit_tests

[Lukas Giessmann]

Author: lgiessmann
Date: Wed Mar 24 14:06:03 2010
New Revision: 253

Log:
new-datamodel: added unit-tests for "make-construct" --> "TopicC"

Modified:
   branches/new-datamodel/src/unit_tests/datamodel_test.lisp

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 14:06:03 2010
@@ -71,10 +71,10 @@
 	   :test-make-VariantC
 	   :test-make-RoleC
 	   :test-make-TopicMapC
-	   :test-make-AssociationC))
+	   :test-make-AssociationC
+	   :test-make-TopicC))
 
 
-;;TODO: test make-construct
 ;;TODO: test merge-constructs
 
 
@@ -2485,6 +2485,86 @@
 	    (is (= (length (roles assoc-3)) 2))))))))
 
 
+(test test-make-TopicC ()
+  "Tests the function make-construct corresponding to TopicC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-1 100)
+	  (ii-1 (make-construct 'ItemIdentifierC :uri "ii-1"))
+	  (ii-2 (make-construct 'ItemIdentifierC :uri "ii-2"))
+	  (ii-3 (make-construct 'ItemIdentifierC :uri "ii-3"))
+	  (psi-1 (make-construct 'PersistentIdC :uri "psi-1"))
+	  (psi-2 (make-construct 'PersistentIdC :uri "psi-2"))
+	  (psi-3 (make-construct 'PersistentIdC :uri "psi-3"))
+	  (sl-1 (make-construct 'SubjectLocatorC :uri "sl-1"))
+	  (sl-2 (make-construct 'SubjectLocatorC :uri "sl-2"))
+	  (sl-3 (make-construct 'SubjectLocatorC :uri "sl-3"))
+	  (variant-1 (make-construct 'VariantC :datatype "dt-1"
+				   :charvalue "cv-1"))
+	  (variant-2 (make-construct 'VariantC :datatype "dt-2"
+				     :charvalue "cv-2"))
+	  (type-1 (make-instance 'TopicC))
+	  (type-2 (make-instance 'TopicC))
+	  (type-3 (make-instance 'TopicC))
+	  (theme-1 (make-instance 'TopicC))
+	  (theme-2 (make-instance 'TopicC))
+	  (theme-3 (make-instance 'TopicC)))
+      (let ((name-1 (make-construct 'NameC :charvalue "cv-3"
+				    :start-revision rev-1
+				    :variants (list variant-1)
+				    :instance-of type-1
+				    :themes (list theme-1 theme-2)))
+	    (name-2 (make-construct 'NameC :charvalue "cv-4"
+				    :start-revision rev-1
+				    :variants (list variant-2)
+				    :instance-of type-2
+				    :themes (list theme-3 theme-2)))
+	    (occ-1 (make-construct 'OccurrenceC :charvalue "cv-5"
+				   :start-revision rev-1
+				   :themes (list theme-1)
+				   :instance-of type-3)))
+	(let ((top-1 (make-construct 'TopicC :start-revision rev-1))
+	      (top-2 (make-construct 'TopicC :start-revision rev-1
+				     :item-identifiers (list ii-1 ii-2)
+				     :psis (list psi-1 psi-2 psi-3)
+				     :locators (list sl-1 sl-2)
+				     :names (list name-1)
+				     :occurrences (list occ-1))))
+	  (setf *TM-REVISION* rev-1)
+	  (signals error (make-construct 'TopicC))
+	  (is-false (item-identifiers top-1))
+	  (is-false (psis top-1))
+	  (is-false (locators top-1))
+	  (is-false (names top-1))
+	  (is-false (occurrences top-1))
+	  (is (eql (find-item-by-revision top-1 rev-1) top-1))
+	  (is (= (length (item-identifiers top-2)) 2))
+	  (is (= (length (union (list ii-1 ii-2) (item-identifiers top-2))) 2))
+	  (is (= (length (locators top-2)) 2))
+	  (is (= (length (union (list sl-1 sl-2) (locators top-2))) 2))
+	  (is (= (length (psis top-2)) 3))
+	  (is (= (length (union (list psi-1 psi-2 psi-3) (psis top-2))) 3))
+	  (is (= (length (names top-2)) 1))
+	  (is (eql (first (names top-2)) name-1))
+	  (is (= (length (occurrences top-2)) 1))
+	  (is (eql (first (occurrences top-2)) occ-1))
+	  (is (eql (find-item-by-revision occ-1 rev-1 top-2) occ-1))
+	  (let ((top-3 (make-construct 'TopicC :start-revision rev-1
+				       :item-identifiers (list ii-2 ii-3)
+				       :locators (list sl-3)
+				       :names (list name-2))))
+	    (is (= (length (item-identifiers top-3)) 3))
+	    (is (= (length (union (list ii-1 ii-2 ii-3)
+				  (item-identifiers top-3))) 3))
+	    (is (= (length (locators top-3)) 3))
+	    (is (= (length (union (list sl-1 sl-2 sl-3) (locators top-3))) 3))
+	    (is (= (length (psis top-3)) 3))
+	    (is (= (length (union (list psi-1 psi-2 psi-3) (psis top-3))) 3))
+	    (is (= (length (names top-3)) 2))
+	    (is (= (length (union (list name-1 name-2) (names top-3))) 2))
+	    (is (= (length (occurrences top-3)) 1))
+	    (is (eql (first (occurrences top-3)) occ-1))))))))
+
+
 
 
 (defun run-datamodel-tests()
@@ -2541,4 +2621,5 @@
   (it.bese.fiveam:run! 'test-make-RoleC)
   (it.bese.fiveam:run! 'test-make-TopicMapC)
   (it.bese.fiveam:run! 'test-make-AssociationC)
+  (it.bese.fiveam:run! 'test-make-TopicC)
   )
\ No newline at end of file