Author: lgiessmann Date: Tue Mar 16 08:56:24 2010 New Revision: 228
Log: new-datamodel: added some unit-tests for equivalent-construct --> RoleC, AssociationC, TopicC, TopicMapC; added equivalent-construct to TopicMapC; fixed a bug in equivalent-construct for all classes derived from ReifiableConstructC.
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 Tue Mar 16 08:56:24 2010 @@ -649,9 +649,12 @@
;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defgeneric equivalent-construct (construct &key start-revision &allow-other-keys) +(defgeneric equivalent-construct (construct &key start-revision + &allow-other-keys) (:documentation "Returns t if the passed construct is equivalent to the passed - key arguments (TMDM equality rules.")) + key arguments (TMDM equality rules. Parent-equality is not + checked in this methods, so the user has to pass children of + the same parent."))
(defgeneric get-most-recent-version-info (construct) @@ -786,6 +789,7 @@ ;;; PointerC (defmethod equivalent-construct ((construct PointerC) &key start-revision (uri "")) + "All Pointers are equal if they have the same URI value." (declare (string uri) (ignorable start-revision)) (string= (uri construct) uri))
@@ -815,6 +819,7 @@ ;;; TopicIdentificationC (defmethod equivalent-construct ((construct TopicIdentificationC) &key start-revision (uri "") (xtm-id "")) + "TopicIdentifiers are equal if teh URI and XTM-ID values are equal." (declare (string uri xtm-id)) (let ((equivalent-pointer (call-next-method construct :start-revision start-revision @@ -902,6 +907,11 @@ (defmethod equivalent-construct ((construct TopicC) &key (start-revision 0) (psis nil) (locators nil) (item-identifiers nil)) + "Isidorus handles Topic-equality only by the topic's identifiers + 'psis', 'subject locators' and 'item identifiers'. Names and occurences + are not checked becuase we don't know when a topic is finalized and owns + all its charactersitics. T is returned if the topic owns one of the given + identifier-URIs." (declare (integer start-revision) (list psis locators item-identifiers)) (when (intersection @@ -1356,8 +1366,8 @@ &key (start-revision 0) (reifier nil) (item-identifiers nil) (charvalue "") (instance-of nil) (themes nil)) - "Equality rule: Characteristics are equal if charvalue, themes and the parent- - constructs are equal." + "Equality rule: Characteristics are equal if charvalue, themes and + instance-of are equal." (declare (string charvalue) (list themes item-identifiers) (integer start-revision) (type (or null TopicC) instance-of reifier)) @@ -1449,9 +1459,11 @@ (item-identifiers nil) (charvalue "") (themes nil) (instance-of nil) (datatype "")) - (declare (type (or null TopicC) instance-of) (string datatype) - (ignorable start-revision charvalue themes instance-of - reifier item-identifiers)) + "Occurrences are equal if their charvalue, datatype, themes and + instance-of properties are equal." + (declare (type (or null TopicC) instance-of reifier) (string datatype) + (list item-identifiers) + (ignorable start-revision charvalue themes instance-of)) (let ((equivalent-characteristic (call-next-method))) (or (and equivalent-characteristic (string= (datatype construct) datatype)) @@ -1464,8 +1476,11 @@ &key (start-revision 0) (reifier nil) (item-identifiers nil) (charvalue "") (themes nil) (datatype "")) - (declare (string datatype) (ignorable start-revision charvalue themes - reifier item-identifiers)) + "Variants are equal if their charvalue, datatype and themes + properties are equal." + (declare (string datatype) (list item-identifiers) + (ignorable start-revision charvalue themes) + (type (or null TopicC) reifier)) (let ((equivalent-characteristic (call-next-method))) (or (and equivalent-characteristic (string= (datatype construct) datatype)) @@ -1478,6 +1493,8 @@ &key (start-revision 0) (reifier nil) (item-identifiers nil) (charvalue "") (themes nil) (instance-of nil)) + "Names are equal if their charvalue, instance-of and themes properties + are equal." (declare (type (or null TopicC) instance-of) (ignorable start-revision charvalue instance-of themes reifier item-identifiers)) @@ -1548,6 +1565,8 @@ &key (start-revision 0) (reifier nil) (item-identifiers nil) (roles nil) (instance-of nil) (themes nil)) + "Associations are equal if their themes, instance-of and roles + properties are equal." (declare (integer start-revision) (list roles themes item-identifiers) (type (or null TopicC) instance-of reifier)) (or @@ -1630,6 +1649,7 @@ &key (start-revision 0) (reifier nil) (item-identifiers nil) (player nil) (instance-of nil)) + "Roles are equal if their instance-of and player properties are equal." (declare (integer start-revision) (type (or null TopicC) player instance-of reifier) (list item-identifiers)) @@ -1764,7 +1784,9 @@ ;;; ReifiableConstructC (defgeneric equivalent-reifiable-construct (construct reifier item-identifiers &key start-revision) - (:documentation "Returns t if the passed constructs are TMDM equal.") + (:documentation "Returns t if the passed constructs are TMDM equal, i.e + the reifiable construct have to share an item identifier + or reifier.") (:method ((construct ReifiableConstructC) reifier item-identifiers &key (start-revision 0)) (declare (integer start-revision) (list item-identifiers) @@ -1904,7 +1926,8 @@ ;;; TypableC (defgeneric equivalent-typable-construct (construct instance-of &key start-revision) - (:documentation "Returns t if the passed constructs are TMDM equal.") + (:documentation "Returns t if the passed constructs are TMDM equal, i.e. + the typable constructs have to own the same type.") (:method ((construct TypableC) instance-of &key (start-revision 0)) (declare (integer start-revision) (type (or null TopicC) instance-of)) @@ -1913,7 +1936,8 @@
;;; ScopableC (defgeneric equivalent-scopable-construct (construct themes &key start-revision) - (:documentation "Returns t if the passed constructs are TMDM equal.") + (:documentation "Returns t if the passed constructs are TMDM equal, i.e. + the scopable constructs have to own the same themes.") (:method ((construct ScopableC) themes &key (start-revision 0)) (declare (integer start-revision) (list themes)) (not (set-exclusive-or (themes construct :revision start-revision) @@ -2041,6 +2065,16 @@
;;; TopicMapC +(defmethod equivalent-construct ((construct TopicMapC) + &key (start-revision 0) (reifier nil) + (item-identifiers nil)) + "TopicMaps equality if they share the same item-identier or reifier." + (declare (list item-identifiers) (integer start-revision) + (type (or null TopicC) reifier)) + (equivalent-reifiable-construct construct reifier item-identifiers + :start-revision start-revision)) + + (defmethod delete-construct :before ((construct TopicMapC)) (dolist (top (slot-p construct 'topics)) (remove-association construct 'topics top))
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 Tue Mar 16 08:56:24 2010 @@ -53,7 +53,11 @@ :test-equivalent-PointerC :test-equivalent-OccurrenceC :test-equivalent-NameC - :test-equivalent-VariantC)) + :test-equivalent-VariantC + :test-equivalent-RoleC + :test-equivalent-AssociationC + :test-equivalent-TopicC + :test-equivalent-TopicMapC))
;;TODO: test merge-constructs when merging was caused by an item-dentifier, @@ -1490,6 +1494,154 @@ (is-false (d::equivalent-construct var-1 :reifier reifier-2)))))
+(test test-equivalent-RoleC () + "Tests the functions equivalent-construct depending on RoleC." + (with-fixture with-empty-db (*db-dir*) + (let ((role-1 (make-instance 'd:RoleC)) + (type-1 (make-instance 'd:TopicC)) + (type-2 (make-instance 'd:TopicC)) + (player-1 (make-instance 'd:TopicC)) + (player-2 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (ii-3 (make-instance 'd:ItemIdentifierC :uri "ii-3")) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-type role-1 type-1) + (add-player role-1 player-1) + (add-item-identifier role-1 ii-1) + (add-item-identifier role-1 ii-2) + (add-reifier role-1 reifier-1) + (is-true (d::equivalent-construct role-1 :player player-1 + :instance-of type-1)) + (is-true (d::equivalent-construct role-1 + :item-identifiers (list ii-1 ii-3))) + (is-true (d::equivalent-construct role-1 :reifier reifier-1)) + (is-false (d::equivalent-construct role-1 :player player-2 + :instance-of type-1)) + (is-false (d::equivalent-construct role-1 :player player-1 + :instance-of type-2)) + (is-false (d::equivalent-construct role-1 + :item-identifiers (list ii-3))) + (is-false (d::equivalent-construct role-1 :reifier reifier-2)) + (setf *TM-REVISION* revision-2) + (delete-item-identifier role-1 ii-1 :revision revision-2) + (delete-player role-1 player-1 :revision revision-2) + (add-player role-1 player-2) + (delete-type role-1 type-1 :revision revision-2) + (add-type role-1 type-2) + (delete-reifier role-1 reifier-1 :revision revision-2) + (add-reifier role-1 reifier-2) + (is-true (d::equivalent-construct role-1 :player player-2 + :instance-of type-2)) + (is-true (d::equivalent-construct role-1 + :item-identifiers (list ii-2))) + (is-true (d::equivalent-construct role-1 :reifier reifier-2)) + (is-false (d::equivalent-construct role-1 :player player-1 + :instance-of type-2)) + (is-false (d::equivalent-construct role-1 :player player-2 + :instance-of type-1)) + (is-false (d::equivalent-construct role-1 + :item-identifiers (list ii-1))) + (is-false (d::equivalent-construct role-1 :reifier reifier-1)) + (is-true (d::equivalent-construct role-1 :start-revision revision-1 + :item-identifiers (list ii-1))) + (is-true (d::equivalent-construct role-1 :reifier reifier-1 + :start-revision revision-1))))) + + +(test test-equivalent-AssociationC () + "Tests the functions equivalent-construct depending on AssociationC." + (with-fixture with-empty-db (*db-dir*) + (let ((assoc-1 (make-instance 'd:AssociationC)) + (role-1 (make-instance 'd:RoleC)) + (role-2 (make-instance 'd:RoleC)) + (role-3 (make-instance 'd:RoleC)) + (type-1 (make-instance 'd:TopicC)) + (type-2 (make-instance 'd:TopicC)) + (scope-1 (make-instance 'd:TopicC)) + (scope-2 (make-instance 'd:TopicC)) + (scope-3 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (revision-1 100)) + (setf *TM-REVISION* revision-1) + (d:add-role assoc-1 role-1) + (d:add-role assoc-1 role-2) + (d:add-type assoc-1 type-1) + (d:add-theme assoc-1 scope-1) + (d:add-theme assoc-1 scope-2) + (d:add-item-identifier assoc-1 ii-1) + (d:add-reifier assoc-1 reifier-1) + (is-true (d::equivalent-construct + assoc-1 :roles (list role-1 role-2) :instance-of type-1 + :themes (list scope-1 scope-2))) + (is-true (d::equivalent-construct assoc-1 + :item-identifiers (list ii-1 ii-2))) + (is-true (d::equivalent-construct assoc-1 :reifier reifier-1)) + (is-false (d::equivalent-construct + assoc-1 :roles (list role-1 role-2 role-3) :instance-of type-1 + :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + assoc-1 :roles (list role-1 role-2) :instance-of type-2 + :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + assoc-1 :roles (list role-1 role-2) :instance-of type-1 + :themes (list scope-1 scope-3 scope-2))) + (is-false (d::equivalent-construct assoc-1 :item-identifiers (list ii-2))) + (is-false (d::equivalent-construct assoc-1 :reifeir reifier-2))))) + + +(test test-equivalent-TopicC () + "Tests the functions equivalent-construct depending on TopicC." + (with-fixture with-empty-db (*db-dir*) + (let ((top-1 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (sl-1 (make-instance 'd:SubjectLocatorC :uri "sl-1")) + (sl-2 (make-instance 'd:SubjectLocatorC :uri "sl-2")) + (psi-1 (make-instance 'd:PersistentIdC :uri "psi-1")) + (psi-2 (make-instance 'd:PersistentIdC :uri "psi-2")) + (revision-1 100)) + (setf *TM-REVISION* revision-1) + (d:add-item-identifier top-1 ii-1) + (d:add-locator top-1 sl-1) + (d:add-psi top-1 psi-1) + (is-true (d::equivalent-construct top-1 + :item-identifiers (list ii-1 ii-2))) + (is-true (d::equivalent-construct top-1 :locators (list sl-1 sl-2) + :psis (list psi-1 psi-2) + :item-identifiers (list ii-1 ii-2))) + (is-true (d::equivalent-construct top-1 :locators (list sl-1 sl-2))) + (is-true (d::equivalent-construct top-1 :psis (list psi-1 psi-2))) + (is-false (d::equivalent-construct top-1 :item-identifiers (list ii-2) + :psis (list psi-2) + :locators (list sl-2)))))) + + +(test test-equivalent-TopicMapC () + "Tests the functions equivalent-construct depending on TopicMapC." + (with-fixture with-empty-db (*db-dir*) + (let ((tm-1 (make-instance 'd:TopicMapC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (revision-1 100)) + (setf *TM-REVISION* revision-1) + (d:add-item-identifier tm-1 ii-1) + (d:add-reifier tm-1 reifier-1) + (is-true (d::equivalent-construct tm-1 + :item-identifiers (list ii-1 ii-2))) + (is-true (d::equivalent-construct tm-1 :reifier reifier-1)) + (is-false (d::equivalent-construct tm-1 :item-identifiers (list ii-2))) + (is-false (d::equivalent-construct tm-1 :reifier reifier-2))))) +
(defun run-datamodel-tests() "Runs all tests of this test-suite." @@ -1527,4 +1679,8 @@ (it.bese.fiveam:run! 'test-equivalent-OccurrenceC) (it.bese.fiveam:run! 'test-equivalent-NameC) (it.bese.fiveam:run! 'test-equivalent-VariantC) + (it.bese.fiveam:run! 'test-equivalent-RoleC) + (it.bese.fiveam:run! 'test-equivalent-AssociationC) + (it.bese.fiveam:run! 'test-equivalent-TopicC) + (it.bese.fiveam:run! 'test-equivalent-TopicMapC) ) \ No newline at end of file