Author: lgiessmann Date: Mon Mar 22 17:58:31 2010 New Revision: 248

Log: new-datamodel: added unit-tests for "make-construct" related to "ItemIdentifierC", "PersistentIdC", "SubjectLocatorC" and "TopicIdentificationC"

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 Mon Mar 22 17:58:31 2010 @@ -61,7 +61,11 @@ :test-class-p :test-find-item-by-revision :test-make-Unknown - :test-make-VersionedConstructC)) + :test-make-VersionedConstructC + :test-make-TopicIdentificationC + :test-make-PersistentIdC + :test-make-SubjectLocatorC + :test-make-ItemIdentifierC))

;;TODO: test make-construct @@ -1916,6 +1920,134 @@ (d::versions psi-assoc)))))))

+(test test-make-TopicIdentificationC () + "Tests the function make-construct corresponding to TopicIdentificationC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-0 0) + (rev-0-5 50) + (rev-1 100) + (top-1 (make-instance 'TopicC))) + (let ((tid-1 (make-construct 'TopicIdentificationC + :uri "tid-1" :xtm-id "xtm-id-1")) + (tid-2 (make-construct 'TopicIdentificationC + :uri "tid-2" :xtm-id "xtm-id-2" + :identified-construct top-1 + :start-revision rev-1))) + (is (string= (uri tid-1) "tid-1")) + (is (string= (xtm-id tid-1) "xtm-id-1")) + (is-false (d::slot-p tid-1 'd::identified-construct)) + (is (string= (uri tid-2) "tid-2")) + (is (string= (xtm-id tid-2) "xtm-id-2")) + (is (= (length (d::slot-p tid-2 'd::identified-construct)) 1)) + (is (= (length (d::versions + (first (d::slot-p tid-2 'd::identified-construct)))) 1)) + (is (= (d::start-revision + (first (d::versions + (first (d::slot-p tid-2 'd::identified-construct))))) + rev-1)) + (is (= (d::end-revision + (first (d::versions + (first (d::slot-p tid-2 'd::identified-construct))))) + rev-0)) + (is (eql (identified-construct tid-2 :revision rev-1) top-1)) + (is-false (identified-construct tid-2 :revision rev-0-5)) + (is (eql (find-item-by-revision tid-2 rev-1 top-1) tid-2)))))) + + +(test test-make-PersistentIdC () + "Tests the function make-construct corresponding to PersistentIdC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-0 0) + (rev-0-5 50) + (rev-1 100) + (top-1 (make-instance 'TopicC))) + (let ((psi-1 (make-construct 'PersistentIdC :uri "psi-1")) + (psi-2 (make-construct 'PersistentIdC + :uri "psi-2" + :identified-construct top-1 + :start-revision rev-1))) + (is (string= (uri psi-1) "psi-1")) + (is-false (d::slot-p psi-1 'd::identified-construct)) + (is (string= (uri psi-2) "psi-2")) + (is (= (length (d::slot-p psi-2 'd::identified-construct)) 1)) + (is (= (length (d::versions + (first (d::slot-p psi-2 'd::identified-construct)))) 1)) + (is (= (d::start-revision + (first (d::versions + (first (d::slot-p psi-2 'd::identified-construct))))) + rev-1)) + (is (= (d::end-revision + (first (d::versions + (first (d::slot-p psi-2 'd::identified-construct))))) + rev-0)) + (is (eql (identified-construct psi-2 :revision rev-1) top-1)) + (is-false (identified-construct psi-2 :revision rev-0-5)) + (is (eql (find-item-by-revision psi-2 rev-1 top-1) psi-2)))))) + + +(test test-make-SubjectLocatorC () + "Tests the function make-construct corresponding to SubjectLocatorC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-0 0) + (rev-0-5 50) + (rev-1 100) + (top-1 (make-instance 'TopicC))) + (let ((sl-1 (make-construct 'SubjectLocatorC :uri "sl-1")) + (sl-2 (make-construct 'SubjectLocatorC + :uri "sl-2" + :identified-construct top-1 + :start-revision rev-1))) + (is (string= (uri sl-1) "sl-1")) + (is-false (d::slot-p sl-1 'd::identified-construct)) + (is (string= (uri sl-2) "sl-2")) + (is (= (length (d::slot-p sl-2 'd::identified-construct)) 1)) + (is (= (length (d::versions + (first (d::slot-p sl-2 'd::identified-construct)))) 1)) + (is (= (d::start-revision + (first (d::versions + (first (d::slot-p sl-2 'd::identified-construct))))) + rev-1)) + (is (= (d::end-revision + (first (d::versions + (first (d::slot-p sl-2 'd::identified-construct))))) + rev-0)) + (is (eql (identified-construct sl-2 :revision rev-1) top-1)) + (is-false (identified-construct sl-2 :revision rev-0-5)) + (is (eql (find-item-by-revision sl-2 rev-1 top-1) sl-2)))))) + + +(test test-make-ItemIdentifierC () + "Tests the function make-construct corresponding to ItemIdentifierC." + (with-fixture with-empty-db (*db-dir*) + (let ((rev-0 0) + (rev-0-5 50) + (rev-1 100) + (top-1 (make-instance 'AssociationC))) + (let ((ii-1 (make-construct 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-construct 'ItemIdentifierC + :uri "ii-2" + :identified-construct top-1 + :start-revision rev-1))) + (is (string= (uri ii-1) "ii-1")) + (is-false (d::slot-p ii-1 'd::identified-construct)) + (is (string= (uri ii-2) "ii-2")) + (is (= (length (d::slot-p ii-2 'd::identified-construct)) 1)) + (is (= (length (d::versions + (first (d::slot-p ii-2 'd::identified-construct)))) 1)) + (is (= (d::start-revision + (first (d::versions + (first (d::slot-p ii-2 'd::identified-construct))))) + rev-1)) + (is (= (d::end-revision + (first (d::versions + (first (d::slot-p ii-2 'd::identified-construct))))) + rev-0)) + (is (eql (identified-construct ii-2 :revision rev-1) top-1)) + (is-false (identified-construct ii-2 :revision rev-0-5)) + (is (eql (find-item-by-revision ii-2 rev-1 top-1) ii-2)))))) + + +

(defun run-datamodel-tests() @@ -1962,4 +2094,8 @@ (it.bese.fiveam:run! 'test-find-item-by-revision) (it.bese.fiveam:run! 'test-make-Unknown) (it.bese.fiveam:run! 'test-make-VersionedConstructC) + (it.bese.fiveam:run! 'test-make-TopicIdentificationC) + (it.bese.fiveam:run! 'test-make-PersistentIdC) + (it.bese.fiveam:run! 'test-make-SubjectLocatorC) + (it.bese.fiveam:run! 'test-make-ItemIdentifierC) ) \ No newline at end of file