Author: lgiessmann Date: Mon Mar 22 14:49:05 2010 New Revision: 247 Log: new-datamodel: added some unit-test for "make-construct" --> "VersionedConstructC" and unknown class; fixed a problem in "make-construct" that appears when creating "VersionedConstructC"s 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 Mon Mar 22 14:49:05 2010 @@ -2692,6 +2692,9 @@ history accordingly. Returns the object in question. Methods use specific keyword arguments for their purpose." (declare (symbol class-symbol)) + (when (and (VersionedConstructC-p class-symbol) + (not (getf args :start-revision))) + (error "From make-construct(): start-revision must be set")) (let ((construct (cond ((PointerC-p class-symbol) @@ -2707,7 +2710,8 @@ ((AssociationC-p class-symbol) (apply #'make-association args)) ((VersionedConstructC-p class-symbol) - (apply #'make-instance (rec-remf args :start-revision))) + (apply #'make-instance class-symbol + (rec-remf args :start-revision))) (t (apply #'make-instance class-symbol args)))) (start-revision (getf args :start-revision))) @@ -2718,8 +2722,6 @@ (complete-scopable construct (getf args :themes) :start-revision start-revision)) (when (typep construct 'VersionedConstructC) - (unless start-revision - (error "From make-construct(): start-revision must be set")) (add-to-version-history construct :start-revision start-revision)) (if (typep construct 'ReifiableConstructC) (complete-reifiable construct (getf args :item-identtifiers) 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 14:49:05 2010 @@ -59,7 +59,9 @@ :test-equivalent-TopicC :test-equivalent-TopicMapC :test-class-p - :test-find-item-by-revision)) + :test-find-item-by-revision + :test-make-Unknown + :test-make-VersionedConstructC)) ;;TODO: test make-construct @@ -1874,6 +1876,46 @@ +(test test-make-Unknown () + "Tests the function make-construct corresponding to an unknown class." + (defclass Unknown () + ((value :initarg :value + :accessor value))) + (let ((construct (make-construct 'Unknown :value "value"))) + (is-true construct) + (string= (value construct) "value"))) + + +(test test-make-VersionedConstructC () + "Tests the function make-construct corresponding to VersionedConstructC." + (with-fixture with-empty-db (*db-dir*) + (let ((psi-1 (make-instance 'PersistentIdC :uri "psi-1")) + (top-1 (make-instance 'TopicC)) + (rev-0 0) + (rev-1 100) + (rev-2 200)) + (let ((vc (make-construct 'VersionedConstructC + :start-revision rev-2)) + (psi-assoc (make-construct 'd::PersistentIdAssociationC + :start-revision rev-1 + :identifier psi-1 + :parent-construct top-1))) + (signals error (make-construct 'd::PersistentIdAssociationC + :start-revision rev-1 + :identifier psi-1)) + (signals error (make-construct 'VersionedConstructC)) + (is (= (length (d::versions vc)) 1)) + (is-true (find-if #'(lambda(vi) + (and (= (d::start-revision vi) rev-2) + (= (d::end-revision vi) rev-0))) + (d::versions vc))) + (is (= (length (d::versions psi-assoc)) 1)) + (is-true (find-if #'(lambda(vi) + (and (= (d::start-revision vi) rev-1) + (= (d::end-revision vi) rev-0))) + (d::versions psi-assoc))))))) + + (defun run-datamodel-tests() @@ -1918,4 +1960,6 @@ (it.bese.fiveam:run! 'test-equivalent-TopicMapC) (it.bese.fiveam:run! 'test-class-p) (it.bese.fiveam:run! 'test-find-item-by-revision) + (it.bese.fiveam:run! 'test-make-Unknown) + (it.bese.fiveam:run! 'test-make-VersionedConstructC) ) \ No newline at end of file