Author: lgiessmann Date: Sat Mar 27 16:30:12 2010 New Revision: 254 Log: new-datamodel: added the generic "equivalent-constructs" that checks the TMDM equality of two "TopicMapConstructC"s and is needed for "merge-constructs" 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 Sat Mar 27 16:30:12 2010 @@ -155,7 +155,6 @@ (in-package :datamodel) - ;;TODO: check merge-constructs in add-topic-identifier, ;; add-item-identifier/add-reifier (can merge the parent constructs ;; and the parent's parent construct + the reifier constructs), @@ -779,7 +778,14 @@ (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. Parent-equality is not + 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 equivalent-constructs (construct-1 construct-2 &key revision) + (:documentation "Returns t if the passed constructs are equivalent to each + other (TMDM equality rules). Parent-equality is not checked in this methods, so the user has to pass children of the same parent.")) @@ -923,6 +929,17 @@ ;;; TopicMapconstructC +(defgeneric strictly-equivalent-constructs (construct-1 construct-2 + &key revision) + (:documentation "Checks if two topic map constructs are not identical but + equal according to the TMDM equality rules.") + (:method ((construct-1 TopicMapConstructC) (construct-2 TopicMapConstructC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (and (equivalent-constructs construct-1 construct-2 :revision revision) + (not (eql construct-1 construct-2))))) + + (defmethod check-for-duplicate-identifiers ((construct TopicMapConstructC) &key revision) (declare (ignorable revision construct)) @@ -948,6 +965,12 @@ ;;; PointerC +(defmethod equivalent-constructs ((construct-1 PointerC) (construct-2 PointerC) + &key (revision nil)) + (declare (ignorable revision)) + (string= (uri construct-1) (uri construct-2))) + + (defgeneric PointerC-p (class-symbol) (:documentation "Returns t if the passed symbol corresponds to the class PointerC or one of its subclasses.") @@ -1018,6 +1041,14 @@ ;;; TopicIdentificationC +(defmethod equivalent-constructs ((construct-1 PointerC) (construct-2 PointerC) + &key (revision nil)) + (declare (ignorable revision)) + (and (call-next-method) + (string= (xtm-id construct-1) (xtm-id construct-2)))) + + + (defgeneric TopicIdentificationC-p (class-symbol) (:documentation "Returns t if the passed class symbol is equal to TopicIdentificationC.") @@ -1143,6 +1174,20 @@ ;;; TopicC +(defmethod equivalent-constructs ((construct-1 TopicC) (construct-2 TopicC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (when (intersection (union + (union (item-identifiers construct-1 :revision revision) + (locators construct-1 :revision revision)) + (psis construct-1 :revision revision)) + (union + (union (item-identifiers construct-2 :revision revision) + (locators construct-2 :revision revision)) + (psis construct-2 :revision revision))) + t)) + + (defgeneric TopicC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to TopicC.") (:method ((class-symbol symbol)) @@ -1714,6 +1759,17 @@ ;;; CharacteristicC +(defmethod equivalent-constructs ((construct-1 CharacteristicC) + (construct-2 CharacteristicC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (and (string= (charvalue construct-1) (charvalue construct-2)) + (eql (instance-of construct-1 :revision revision) + (instance-of construct-2 :revision revision)) + (not (set-exclusive-or (themes construct-1 :revision revision) + (themes construct-2 :revision revision))))) + + (defgeneric CharacteristicC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to CharacteristicC or one of its subtypes.") @@ -1845,6 +1901,13 @@ ;;; OccurrenceC +(defmethod equivalent-constructs ((construct-1 OccurrenceC) (construct-2 OccurrenceC) + &key (revision *TM-REVISION*)) + (declare (ignorable revision)) + (and (call-next-method) + (string= (datatype construct-1) (datatype construct-2)))) + + (defgeneric OccurrenceC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to OccurrenceC.") (:method ((class-symbol symbol)) @@ -1867,6 +1930,13 @@ ;;; VariantC +(defmethod equivalent-constructs ((construct-1 VariantC) (construct-2 VariantC) + &key (revision *TM-REVISION*)) + (declare (ignorable revision)) + (and (call-next-method) + (string= (datatype construct-1) (datatype construct-2)))) + + (defgeneric VariantC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to VariantC.") (:method ((class-symbol symbol)) @@ -1977,6 +2047,18 @@ ;;; AssociationC +(defmethod equivalent-constructs ((construct-1 AssociationC) + (construct-2 AssociationC) + &key (revision *TM-REVISION*)) + (declare (ignorable revision)) + (and (eql (instance-of construct-1 :revision revision) + (instance-of construct-2 :revision revision)) + (not (set-exclusive-or (themes construct-1 :revision revision) + (themes construct-1 :revision revision))) + (not (set-exclusive-or (roles construct-1 :revision revision) + (roles construct-2 :revision revision))))) + + (defgeneric AssociationC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to AssociationC.") (:method ((class-symbol symbol)) @@ -2082,6 +2164,15 @@ ;;; RoleC +(defmethod equivalent-constructs ((construct-1 RoleC) (construct-2 RoleC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (and (eql (instance-of construct-1 :revision revision) + (instance-of construct-2 :revision revision)) + (eql (player construct-1 :revision revision) + (player construct-1 :revision revision)))) + + (defgeneric RoleC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to RoleC.") (:method ((class-symbol symbol)) @@ -2364,6 +2455,11 @@ (let ((id-owner (identified-construct item-identifier :revision revision))) (when (not (eql id-owner construct)) + (unless (typep construct 'TopicC) + (error (make-condition 'duplicate-identifier-error + :message "From add-item-identifier(): duplicate ItemIdentifier has been found: ~a" + (uri item-identifier) + :uri (uri item-identifier)))) id-owner)))) (let ((merged-construct construct)) (cond (construct-to-be-merged @@ -2649,6 +2745,14 @@ ;;; TopicMapC +(defmethod equivalent-constructs ((construct-1 TopicMapC) (construct-2 TopicMapC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (when (intersection (item-identifiers construct-1 :revision revision) + (item-identifiers construct-2 :revision revision)) + t)) + + (defgeneric TopicMapC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to TopicMapC.") (:method ((class-symbol symbol)) 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 Mar 27 16:30:12 2010 @@ -75,6 +75,7 @@ :test-make-TopicC)) +;;TODO: test equivalent-constructs ;;TODO: test merge-constructs