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