[isidorus-cvs] r206 - in branches/new-datamodel/src: model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Feb 24 19:59:59 UTC 2010
Author: lgiessmann
Date: Wed Feb 24 14:59:58 2010
New Revision: 206
Log:
new-datamodel: added unit-tests for: get-item-by-item-identifier, get-item-by-psi and get-item-by-locator; optimized the function get item-by-identifier
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 Feb 24 14:59:58 2010
@@ -83,7 +83,7 @@
:get-revision
:get-item-by-id
:get-item-by-psi
- :get-item-by-item-identnfier
+ :get-item-by-item-identifier
:get-item-by-locator
:string-integer-p
@@ -94,11 +94,6 @@
(in-package :datamodel)
-
-;;TODO: implement get-item-by-id(TopicC) + unit-tests
-;;TODO: implement get-item-by-psi(TopicC) + unit-tests
-;;TODO: implement get-item-by-locator(TopicC) + unit-tests
-;;TODO: implement get-item-by-item-identifier(ReifiableConstructC) + unit-tests
;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo
;; initarg in make-construct
;;TODO: implement a macro "with-merge-construct" that merges constructs
@@ -1135,7 +1130,7 @@
(delete-if-not
#'(lambda(id)
(string= (uri id) uri))
- (get-instances-by-class identifier-type-symbol))))
+ (get-instances-by-value identifier-type-symbol 'uri uri))))
(when (and possible-ids
(identified-construct (first possible-ids) :revision revision))
(unless (= (length possible-ids) 1)
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 Feb 24 14:59:58 2010
@@ -23,7 +23,10 @@
:test-PersistentIdC
:test-SubjectLocatorC
:test-TopicIdentificationC
- :test-get-item-by-id))
+ :test-get-item-by-id
+ :test-get-item-by-item-identifier
+ :test-get-item-by-locator
+ :test-get-item-by-psi))
;;TODO: test merges-constructs when merging was caused by an item-dentifier
@@ -363,6 +366,132 @@
:revision revision)))))
+(test test-get-item-by-item-identifier ()
+ "Tests the function test-get-item-by-id."
+ (with-fixture with-empty-db (*db-dir*)
+ (let ((ii-1 (make-instance 'ItemIdentifierC
+ :uri "ii-1"))
+ (ii-2 (make-instance 'ItemIdentifierC
+ :uri "ii-2"))
+ (ii-3-1 (make-instance 'ItemIdentifierC
+ :uri "ii-3"))
+ (ii-3-2 (make-instance 'ItemIdentifierC
+ :uri "ii-3"))
+ (top-1 (make-instance 'TopicC))
+ (top-2 (make-instance 'TopicC))
+ (top-3 (make-instance 'TopicC))
+ (revision 100)
+ (revision-2 200))
+ (setf d:*TM-REVISION* revision)
+ (is-false (get-item-by-id "any-ii-id"))
+ (signals error (is-false (get-item-by-item-identifier
+ "any-ii-id" :error-if-nil t)))
+ (signals error (is-false (get-item-by-item-identifier
+ "any-ii-id" :error-if-nil t)))
+ (is-false (get-item-by-item-identifier "any-ii-id"))
+ (add-item-identifier top-1 ii-3-1 :revision revision)
+ (add-item-identifier top-1 ii-3-2 :revision revision)
+ (signals duplicate-identifier-error
+ (get-item-by-item-identifier "ii-3" :revision revision))
+ (add-item-identifier top-2 ii-1)
+ (add-item-identifier top-2 ii-2 :revision revision-2)
+ (is (eql top-2 (get-item-by-item-identifier "ii-1")))
+ (is (eql top-2 (get-item-by-item-identifier "ii-2")))
+ (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision 500)))
+ (is-false (get-item-by-item-identifier "ii-2" :revision revision))
+ (delete-item-identifier top-2 ii-1 :revision revision-2)
+ (is-false (get-item-by-item-identifier "ii-1"))
+ (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision revision)))
+ (add-item-identifier top-3 ii-1 :revision revision-2)
+ (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision revision)))
+ (d::add-to-version-history top-3 :start-revision revision-2)
+ (is (eql top-3 (get-item-by-item-identifier "ii-1"))))))
+
+
+(test test-get-item-by-locator ()
+ "Tests the function test-get-item-by-id."
+ (with-fixture with-empty-db (*db-dir*)
+ (let ((sl-1 (make-instance 'SubjectLocatorC
+ :uri "sl-1"))
+ (sl-2 (make-instance 'SubjectLocatorC
+ :uri "sl-2"))
+ (sl-3-1 (make-instance 'SubjectLocatorC
+ :uri "sl-3"))
+ (sl-3-2 (make-instance 'SubjectLocatorC
+ :uri "sl-3"))
+ (top-1 (make-instance 'TopicC))
+ (top-2 (make-instance 'TopicC))
+ (top-3 (make-instance 'TopicC))
+ (revision 100)
+ (revision-2 200))
+ (setf d:*TM-REVISION* revision)
+ (is-false (get-item-by-id "any-sl-id"))
+ (signals error (is-false (get-item-by-locator
+ "any-sl-id" :error-if-nil t)))
+ (signals error (is-false (get-item-by-locator
+ "any-sl-id" :error-if-nil t)))
+ (is-false (get-item-by-locator "any-sl-id"))
+ (add-locator top-1 sl-3-1 :revision revision)
+ (add-locator top-1 sl-3-2 :revision revision)
+ (signals duplicate-identifier-error
+ (get-item-by-locator "sl-3" :revision revision))
+ (add-locator top-2 sl-1)
+ (add-locator top-2 sl-2 :revision revision-2)
+ (is (eql top-2 (get-item-by-locator "sl-1")))
+ (is (eql top-2 (get-item-by-locator "sl-2")))
+ (is (eql top-2 (get-item-by-locator "sl-1" :revision 500)))
+ (is-false (get-item-by-locator "sl-2" :revision revision))
+ (delete-locator top-2 sl-1 :revision revision-2)
+ (is-false (get-item-by-locator "sl-1"))
+ (is (eql top-2 (get-item-by-locator "sl-1" :revision revision)))
+ (add-locator top-3 sl-1 :revision revision-2)
+ (is (eql top-2 (get-item-by-locator "sl-1" :revision revision)))
+ (d::add-to-version-history top-3 :start-revision revision-2)
+ (is (eql top-3 (get-item-by-locator "sl-1"))))))
+
+
+(test test-get-item-by-psi ()
+ "Tests the function test-get-item-by-id."
+ (with-fixture with-empty-db (*db-dir*)
+ (let ((psi-1 (make-instance 'PersistentIdC
+ :uri "psi-1"))
+ (psi-2 (make-instance 'PersistentIdC
+ :uri "psi-2"))
+ (psi-3-1 (make-instance 'PersistentIdC
+ :uri "psi-3"))
+ (psi-3-2 (make-instance 'PersistentIdC
+ :uri "psi-3"))
+ (top-1 (make-instance 'TopicC))
+ (top-2 (make-instance 'TopicC))
+ (top-3 (make-instance 'TopicC))
+ (revision 100)
+ (revision-2 200))
+ (setf d:*TM-REVISION* revision)
+ (is-false (get-item-by-id "any-psi-id"))
+ (signals error (is-false (get-item-by-locator
+ "any-psi-id" :error-if-nil t)))
+ (signals error (is-false (get-item-by-locator
+ "any-psi-id" :error-if-nil t)))
+ (is-false (get-item-by-locator "any-psi-id"))
+ (add-psi top-1 psi-3-1 :revision revision)
+ (add-psi top-1 psi-3-2 :revision revision)
+ (signals duplicate-identifier-error
+ (get-item-by-locator "psi-3" :revision revision))
+ (add-psi top-2 psi-1)
+ (add-psi top-2 psi-2 :revision revision-2)
+ (is (eql top-2 (get-item-by-locator "psi-1")))
+ (is (eql top-2 (get-item-by-locator "psi-2")))
+ (is (eql top-2 (get-item-by-locator "psi-1" :revision 500)))
+ (is-false (get-item-by-locator "psi-2" :revision revision))
+ (delete-psi top-2 psi-1 :revision revision-2)
+ (is-false (get-item-by-locator "psi-1"))
+ (is (eql top-2 (get-item-by-locator "psi-1" :revision revision)))
+ (add-psi top-3 psi-1 :revision revision-2)
+ (is (eql top-2 (get-item-by-locator "psi-1" :revision revision)))
+ (d::add-to-version-history top-3 :start-revision revision-2)
+ (is (eql top-3 (get-item-by-locator "psi-1"))))))
+
+
(defun run-datamodel-tests()
(it.bese.fiveam:run! 'test-VersionInfoC)
(it.bese.fiveam:run! 'test-VersionedConstructC)
@@ -371,4 +500,7 @@
(it.bese.fiveam:run! 'test-SubjectLocatorC)
(it.bese.fiveam:run! 'test-TopicIdentificationC)
(it.bese.fiveam:run! 'test-get-item-by-id)
+ (it.bese.fiveam:run! 'test-get-item-by-item-identifier)
+ (it.bese.fiveam:run! 'test-get-item-by-locator)
+ (it.bese.fiveam:run! 'test-get-item-by-psi)
)
\ No newline at end of file
More information about the Isidorus-cvs
mailing list