[isidorus-cvs] r217 - in branches/new-datamodel: docs src/model src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Feb 27 11:37:57 UTC 2010
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))
+ , at 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
More information about the Isidorus-cvs
mailing list