[isidorus-cvs] r228 - in branches/new-datamodel/src: model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Mar 16 12:56:25 UTC 2010
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
More information about the Isidorus-cvs
mailing list