Author: lgiessmann Date: Sat Feb 27 06:37:56 2010 New Revision: 217 Log: new-datamodel: added some unit-tests for the class TopicMapC; added the generics add-to-tm and delete-from-tm. Modified: branches/new-datamodel/docs/isidorus_data_model.pdf branches/new-datamodel/docs/isidorus_data_model.vsd branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/docs/isidorus_data_model.pdf ============================================================================== Binary files branches/new-datamodel/docs/isidorus_data_model.pdf (original) and branches/new-datamodel/docs/isidorus_data_model.pdf Sat Feb 27 06:37:56 2010 differ Modified: branches/new-datamodel/docs/isidorus_data_model.vsd ============================================================================== Binary files. No diff available. Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sat Feb 27 06:37:56 2010 @@ -25,7 +25,7 @@ :TopicIdentificationC :TopicC - ;;methods and functions + ;;methods, functions and macros :xtm-id :uri :identified-construct @@ -56,6 +56,8 @@ :delete-role :associations :topics + :add-to-tm + :delete-from-tm :psis :add-psi :delete-psi @@ -86,6 +88,7 @@ :get-item-by-item-identifier :get-item-by-locator :string-integer-p + :with-revision ;;globals :*TM-REVISION* @@ -281,11 +284,11 @@ (elephant:defpclass TopicMapC (ReifiableConstructC VersionedConstructC) - ((topics :accessor topics - :associate (TopicC in-topicmaps) + ((topics :associate (TopicC in-topicmaps) + :many-to-many t :documentation "List of topics that explicitly belong to this TM.") - (associations :accessor associations - :associate (AssociationC in-topicmaps) + (associations :associate (AssociationC in-topicmaps) + :many-to-many t :documentation "List of associations that belong to this TM.")) (:documentation "Represnets a topic map.")) @@ -557,6 +560,12 @@ ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defmacro with-revision (revision &rest body) + `(let + ((*TM-REVISION* ,revision)) + ,@body)) + + (defun slot-p (instance slot-symbol) "Returns t if the slot depending on slot-symbol is bound and not nil." (if (slot-boundp instance slot-symbol) @@ -1803,7 +1812,45 @@ construct))) +;;; TopicMapC +(defgeneric topics (construct &key revision) + (:documentation "Returns all TopicC-objects that are contained in the tm.") + (:method ((construct TopicMapC) &key (revision 0)) + (filter-slot-value-by-revision construct 'topics + :start-revision revision))) + + +(defgeneric associations (construct &key revision) + (:documentation "Returns all AssociationC-objects that are contained in the tm.") + (:method ((construct TopicMapC) &key (revision 0)) + (filter-slot-value-by-revision construct 'associations + :start-revision revision))) + + +(defgeneric add-to-tm (construct construct-to-add) + (:documentation "Adds a TM construct (TopicC or AssociationC) to the TM.")) + + +(defmethod add-to-tm ((construct TopicMapC) (construct-to-add TopicC)) + (add-association construct 'topics construct-to-add)) + + +(defmethod add-to-tm ((construct TopicMapC) (construct-to-add AssociationC)) + (add-association construct 'associations construct-to-add)) + + +(defgeneric delete-from-tm (construct construct-to-delete) + (:documentation "Deletes a TM construct (TopicC or AssociationC) from + the TM.")) + + +(defmethod delete-from-tm ((construct TopicMapC) (construct-to-delete TopicC)) + (remove-association construct 'topics construct-to-delete)) + +(defmethod delete-from-tm ((construct TopicMapC) + (construct-to-delete AssociationC)) + (remove-association construct 'associations construct-to-delete)) 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 Sat Feb 27 06:37:56 2010 @@ -35,7 +35,8 @@ :test-TypableC :test-ScopableC :test-RoleC - :test-player)) + :test-player + :test-TopicMapC)) ;;TODO: test delete-construct @@ -868,10 +869,57 @@ (is (= (length (union (list role-1 role-2) (player-in-roles top-1))) 2)) (is (= (length (slot-value top-1 'd::player-in-roles)) 2))))) + + +(test test-TopicMapC () + "Tests various function of the class TopicMapC." + (with-fixture with-empty-db (*db-dir*) + (let ((tm-1 (make-instance 'TopicMapC)) + (tm-2 (make-instance 'TopicMapC)) + (top-1 (make-instance 'TopicC)) + (assoc-1 (make-instance 'AssociationC)) + (revision-0-5 50) + (revision-1 100)) + (setf *TM-REVISION* revision-1) + (is-false (topics tm-1)) + (is-false (in-topicmaps top-1)) + (is-false (in-topicmaps assoc-1)) + (d::add-to-version-history top-1 :start-revision revision-1) + (add-to-tm tm-1 top-1) + (is (= (length (union (list top-1) + (topics tm-1))) 1)) + (is (= (length (union (list tm-1) + (in-topicmaps top-1))) 1)) + (is-false (topics tm-1 :revision revision-0-5)) + (is-false (in-topicmaps top-1 :revision revision-0-5)) + (d::add-to-version-history assoc-1 :start-revision revision-1) + (add-to-tm tm-1 assoc-1) + (is (= (length (union (list assoc-1) + (associations tm-1))) 1)) + (is (= (length (union (list tm-1) + (in-topicmaps assoc-1))) 1)) + (is-false (associations tm-1 :revision revision-0-5)) + (is-false (in-topicmaps assoc-1 :revision revision-0-5)) + (add-to-tm tm-2 top-1) + (is (= (length (union (list top-1) + (topics tm-2))) 1)) + (is (= (length (union (list tm-2 tm-1) + (in-topicmaps top-1))) 2)) + (is-false (topics tm-2 :revision revision-0-5)) + (is-false (in-topicmaps top-1 :revision revision-0-5)) + (d::add-to-version-history assoc-1 :start-revision revision-1) + (add-to-tm tm-2 assoc-1) + (is (= (length (union (list assoc-1) + (associations tm-2))) 1)) + (is (= (length (union (list tm-2 tm-1) + (in-topicmaps assoc-1))) 2)) + (is-false (associations tm-2 :revision revision-0-5)) + (is-false (in-topicmaps assoc-1 :revision revision-0-5))))) (defun run-datamodel-tests() + "Runs all tests of this test-suite." (it.bese.fiveam:run! 'test-VersionInfoC) (it.bese.fiveam:run! 'test-VersionedConstructC) (it.bese.fiveam:run! 'test-ItemIdentifierC) @@ -890,4 +938,4 @@ (it.bese.fiveam:run! 'test-ScopableC) (it.bese.fiveam:run! 'test-RoleC) (it.bese.fiveam:run! 'test-player) -) \ No newline at end of file + (it.bese.fiveam:run! 'test-TopicMapC)) \ No newline at end of file