[isidorus-cvs] r248 - branches/new-datamodel/src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Mar 22 21:58:32 UTC 2010
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
More information about the Isidorus-cvs
mailing list