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