Author: lgiessmann Date: Mon Mar 22 14:14:02 2010 New Revision: 246
Log: replaced all keyword parameters of the form "(revision 0)" or "(start-revision 0)" to "(revision *TM-REVISION*)" and "(start-revision *TM-REVISION*)" to be compatible with the macro "with-revision" which uses the variable "*TM-REVISION*"
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 Mon Mar 22 14:14:02 2010 @@ -156,9 +156,6 @@
-;;TOOD: replace the key argument (revision 0)/(start-revision 0) -;; by (start-revision *TM-REVISION*) (revision *TM-REVISION*) -;; to be compatible to the macro with-revision ;;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), @@ -765,7 +762,7 @@ its parent-construct."))
-(defgeneric check-for-duplicate-identifiers (construct) +(defgeneric check-for-duplicate-identifiers (construct &key revision) (:documentation "Check for possibly duplicate identifiers and signal an duplicate-identifier-error is such duplicates are found"))
@@ -926,8 +923,9 @@
;;; TopicMapconstructC -(defmethod check-for-duplicate-identifiers ((construct TopicMapConstructC)) - (declare (ignore construct)) +(defmethod check-for-duplicate-identifiers ((construct TopicMapConstructC) + &key revision) + (declare (ignorable revision construct)) ;do nothing )
@@ -1009,7 +1007,7 @@ (defgeneric identified-construct (construct &key revision) (:documentation "Returns the identified-construct -> ReifiableConstructC or TopicC that corresponds with the passed revision.") - (:method ((construct PointerC) &key (revision 0)) + (:method ((construct PointerC) &key (revision *TM-REVISION*)) (let ((assocs (map 'list #'parent-construct (filter-slot-value-by-revision construct 'identified-construct @@ -1218,7 +1216,7 @@ (= essentially the OID). If xtm-id is explicitly given, returns one of the topic-ids in that TM (which must then exist).") - (:method ((construct TopicC) &optional (xtm-id nil) (revision 0)) + (:method ((construct TopicC) &optional (xtm-id nil) (revision *TM-REVISION*)) (declare (type (or null string) xtm-id) (integer revision)) (if xtm-id (let ((possible-identifiers @@ -1240,7 +1238,7 @@ (defgeneric topic-identifiers (construct &key revision) (:documentation "Returns the TopicIdentificationC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'topic-identifiers :start-revision revision))) (map 'list #'identifier assocs)))) @@ -1257,7 +1255,8 @@ (let ((all-ids (map 'list #'identifier (slot-p construct 'topic-identifiers))) (construct-to-be-merged - (let ((id-owner (identified-construct topic-identifier))) + (let ((id-owner (identified-construct topic-identifier + :revision revision))) (when (not (eql id-owner construct)) id-owner)))) (let ((merged-construct construct)) @@ -1298,7 +1297,7 @@ (defgeneric psis (construct &key revision) (:documentation "Returns the PersistentIdC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'psis :start-revision revision))) (map 'list #'identifier assocs)))) @@ -1315,7 +1314,7 @@ (let ((all-ids (map 'list #'identifier (slot-p construct 'psis))) (construct-to-be-merged - (let ((id-owner (identified-construct psi))) + (let ((id-owner (identified-construct psi :revision revision))) (when (not (eql id-owner construct)) id-owner)))) (let ((merged-construct construct)) @@ -1354,7 +1353,7 @@ (defgeneric locators (construct &key revision) (:documentation "Returns the SubjectLocatorC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'locators :start-revision revision))) (map 'list #'identifier assocs)))) @@ -1371,7 +1370,7 @@ (let ((all-ids (map 'list #'identifier (slot-p construct 'locators))) (construct-to-be-merged - (let ((id-owner (identified-construct locator))) + (let ((id-owner (identified-construct locator :revision revision))) (when (not (eql id-owner construct)) id-owner)))) (let ((merged-construct construct)) @@ -1409,7 +1408,7 @@
(defmethod get-all-identifiers-of-construct ((construct TopicC) - &key (revision 0)) + &key (revision *TM-REVISION*)) (declare (integer revision)) (append (psis construct :revision revision) (locators construct :revision revision) @@ -1419,7 +1418,7 @@ (defgeneric names (construct &key revision) (:documentation "Returns the NameC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'names :start-revision revision))) (map 'list #'characteristic assocs)))) @@ -1470,7 +1469,7 @@ (defgeneric occurrences (construct &key revision) (:documentation "Returns the OccurrenceC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'occurrences :start-revision revision))) (map 'list #'characteristic assocs)))) @@ -1485,9 +1484,9 @@ (:method ((construct TopicC) (occurrence OccurrenceC) &key (revision *TM-REVISION*)) (when (and (parent occurrence :revision revision) - (not (eql (parent occurrence) construct))) + (not (eql (parent occurrence :revision revision) construct))) (error "From add-occurrence(): ~a can't be owned by ~a since it is already owned by the topic ~a" - occurrence construct (parent occurrence))) + occurrence construct (parent occurrence :revision revision))) (let ((all-occurrences (map 'list #'characteristic (slot-p construct 'occurrences)))) (if (find occurrence all-occurrences) @@ -1520,7 +1519,7 @@ (defgeneric player-in-roles (construct &key revision) (:documentation "Returns the RoleC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'player-in-roles :start-revision revision))) (map 'list #'parent-construct assocs)))) @@ -1529,7 +1528,7 @@ (defgeneric used-as-type (construct &key revision) (:documentation "Returns the TypableC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'used-as-type :start-revision revision))) (map 'list #'typable-construct assocs)))) @@ -1538,7 +1537,7 @@ (defgeneric used-as-theme (construct &key revision) (:documentation "Returns the ScopableC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'used-as-theme :start-revision revision))) (map 'list #'scopable-construct assocs)))) @@ -1547,18 +1546,19 @@ (defgeneric reified-construct (construct &key revision) (:documentation "Returns the ReifiableConstructC-objects that correspond with the passed construct and the passed version.") - (:method ((construct TopicC) &key (revision 0)) + (:method ((construct TopicC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'reified-construct :start-revision revision))) (when assocs (reifiable-construct (first assocs))))))
-(defmethod in-topicmaps ((topic TopicC) &key (revision 0)) +(defmethod in-topicmaps ((topic TopicC) &key (revision *TM-REVISION*)) (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision))
-(defun get-item-by-id (topic-id &key (xtm-id *CURRENT-XTM*) (revision 0) (error-if-nil nil)) +(defun get-item-by-id (topic-id &key (xtm-id *CURRENT-XTM*) + (revision *TM-REVISION*) (error-if-nil nil)) "Gets a topic by its id, assuming an xtm-id. If xtm-id is empty, the current TM is chosen. If xtm-id is nil, choose the global TM with its internal ID, if applicable in the correct revision. If revison is provided, then the code checks @@ -1580,7 +1580,8 @@ 'uri topic-id)))) (when (and possible-top-ids - (identified-construct (first possible-top-ids) :revision revision)) + (identified-construct (first possible-top-ids) + :revision revision)) (unless (= (length possible-top-ids) 1) (error (make-condition 'duplicate-identifier-error @@ -1606,7 +1607,7 @@ result)))
-(defun get-item-by-identifier (uri &key (revision 0) +(defun get-item-by-identifier (uri &key (revision *TM-REVISION*) (identifier-type-symbol 'PersistentIdC) (error-if-nil nil)) "Returns the construct that is bound to the given identifier-uri." @@ -1618,7 +1619,8 @@ (string= (uri id) uri)) (get-instances-by-value identifier-type-symbol 'uri uri)))) (when (and possible-ids - (identified-construct (first possible-ids) :revision revision)) + (identified-construct (first possible-ids) + :revision revision)) (unless (= (length possible-ids) 1) (error (make-condition 'duplicate-identifier-error :message (format nil "(length possible-items ~a) for id ~a" @@ -1634,21 +1636,22 @@ (error "No such item is bound to the given identifier uri.")))))
-(defun get-item-by-item-identifier (uri &key (revision 0) (error-if-nil nil)) +(defun get-item-by-item-identifier (uri &key (revision *TM-REVISION*) + (error-if-nil nil)) "Returns a ReifiableConstructC that is bound to the identifier-uri." (get-item-by-identifier uri :revision revision :identifier-type-symbol 'ItemIdentifierC :error-if-nil error-if-nil))
-(defun get-item-by-psi (uri &key (revision 0) (error-if-nil nil)) +(defun get-item-by-psi (uri &key (revision *TM-REVISION*) (error-if-nil nil)) "Returns a TopicC that is bound to the identifier-uri." (get-item-by-identifier uri :revision revision :identifier-type-symbol 'PersistentIdC :error-if-nil error-if-nil))
-(defun get-item-by-locator (uri &key (revision 0) (error-if-nil nil)) +(defun get-item-by-locator (uri &key (revision *TM-REVISION*) (error-if-nil nil)) "Returns a TopicC that is bound to the identifier-uri." (get-item-by-identifier uri :revision revision :identifier-type-symbol 'SubjectLocatorC @@ -1658,7 +1661,7 @@ (defgeneric list-instanceOf (topic &key tm revision) (:documentation "Generates a list of all topics that this topic is an instance of, optionally filtered by a topic map") - (:method ((topic TopicC) &key (tm nil) (revision 0)) + (:method ((topic TopicC) &key (tm nil) (revision *TM-REVISION*)) (declare (type (or null TopicMapC) tm) (integer revision)) (remove-if @@ -1676,7 +1679,8 @@ (if tm (remove-if-not (lambda (role) - (in-topicmap tm (parent role :revision revision))) + (in-topicmap tm (parent role :revision revision) + :revision revision)) (player-in-roles topic :revision revision)) (player-in-roles topic :revision revision))))))
@@ -1684,7 +1688,7 @@ (defgeneric list-super-types (topic &key tm revision) (:documentation "Generate a list of all topics that this topic is an subclass of, optionally filtered by a topic map") - (:method ((topic TopicC) &key (tm nil) (revision 0)) + (:method ((topic TopicC) &key (tm nil) (revision *TM-REVISION*)) (declare (type (or null TopicMapC) tm) (integer revision)) (remove-if @@ -1702,7 +1706,8 @@ (if tm (remove-if-not (lambda (role) - (in-topicmap tm (parent role :revision revision))) + (in-topicmap tm (parent role :revision revision) + :revision revision)) (player-in-roles topic :revision revision)) (player-in-roles topic :revision revision))))))
@@ -1719,8 +1724,8 @@
(defmethod equivalent-construct ((construct CharacteristicC) - &key (start-revision 0) (charvalue "") - (instance-of nil) (themes nil)) + &key (start-revision *TM-REVISION*) + (charvalue "") (instance-of nil) (themes nil)) "Equality rule: Characteristics are equal if charvalue, themes and instance-of are equal." (declare (string charvalue) (list themes) @@ -1778,7 +1783,7 @@ (:documentation "Returns the parent construct of the passed object that corresponds with the given revision. The returned construct can be a TopicC or a NameC.") - (:method ((construct CharacteristicC) &key (revision 0)) + (:method ((construct CharacteristicC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'parent :start-revision revision))) @@ -1845,15 +1850,15 @@
(defmethod equivalent-construct ((construct OccurrenceC) - &key (start-revision 0) (charvalue "") - (themes nil) (instance-of nil) + &key (start-revision *TM-REVISION*) + (charvalue "") (themes nil) (instance-of nil) (datatype "")) "Occurrences are equal if their charvalue, datatype, themes and instance-of properties are equal." (declare (type (or null TopicC) instance-of) (string datatype) (ignorable start-revision charvalue themes instance-of)) (let ((equivalent-characteristic (call-next-method))) - ;; item-identifiers and reifers are not checked because the equality have to + ;; item-identifiers and reifers are not checked because the equaity have to ;; be variafied without them (and equivalent-characteristic (string= (datatype construct) datatype)))) @@ -1867,8 +1872,8 @@
(defmethod equivalent-construct ((construct VariantC) - &key (start-revision 0) (charvalue "") - (themes nil) (datatype "")) + &key (start-revision *TM-REVISION*) + (charvalue "") (themes nil) (datatype "")) "Variants are equal if their charvalue, datatype and themes properties are equal." (declare (string datatype) (ignorable start-revision charvalue themes)) @@ -1902,8 +1907,8 @@
(defmethod equivalent-construct ((construct NameC) - &key (start-revision 0) (charvalue "") - (themes nil) (instance-of nil)) + &key (start-revision *TM-REVISION*) + (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) @@ -1924,7 +1929,7 @@ (defgeneric variants (construct &key revision) (:documentation "Returns all variants that correspond with the given revision and that are associated with the passed construct.") - (:method ((construct NameC) &key (revision 0)) + (:method ((construct NameC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'variants :start-revision revision))) @@ -1939,7 +1944,7 @@ (when (and (parent variant :revision revision) (not (eql (parent variant :revision revision) construct))) (error "From add-variant(): ~a can't be owned by ~a since it is already owned by the name ~a" - variant construct (parent variant))) + variant construct (parent variant :revision revision))) (let ((all-variants (map 'list #'characteristic (slot-p construct 'variants)))) (if (find variant all-variants) @@ -1977,8 +1982,8 @@
(defmethod equivalent-construct ((construct AssociationC) - &key (start-revision 0) (roles nil) - (instance-of nil) (themes nil)) + &key (start-revision *TM-REVISION*) + (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) @@ -2013,7 +2018,7 @@ (defgeneric roles (construct &key revision) (:documentation "Returns all topics that correspond with the given revision as a scope for the given topic.") - (:method ((construct AssociationC) &key (revision 0)) + (:method ((construct AssociationC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'roles :start-revision revision))) @@ -2054,7 +2059,7 @@ construct)))
-(defmethod in-topicmaps ((association AssociationC) &key (revision 0)) +(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*)) (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision))
@@ -2066,8 +2071,8 @@
(defmethod equivalent-construct ((construct RoleC) - &key (start-revision 0) (player nil) - (instance-of nil)) + &key (start-revision *TM-REVISION*) + (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)) ;; item-identifiers and reifers are not checked because the equality have to @@ -2124,7 +2129,7 @@ t))
-(defmethod parent ((construct RoleC) &key (revision 0)) +(defmethod parent ((construct RoleC) &key (revision *TM-REVISION*)) "Returns the construct's parent corresponding to the given revision." (let ((valid-associations (filter-slot-value-by-revision construct 'parent @@ -2176,7 +2181,7 @@ (defgeneric player (construct &key revision) (:documentation "Returns the construct's player corresponding to the given revision.") - (:method ((construct RoleC) &key (revision 0)) + (:method ((construct RoleC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'player :start-revision revision))) @@ -2228,8 +2233,10 @@
;;; ReifiableConstructC -(defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC)) - (dolist (id (get-all-identifiers-of-construct construct)) +(defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (dolist (id (get-all-identifiers-of-construct construct :revision revision)) (when (> (length (union @@ -2281,7 +2288,7 @@ the reifiable construct have to share an item identifier or reifier.") (:method ((construct ReifiableConstructC) reifier item-identifiers - &key (start-revision 0)) + &key (start-revision *TM-REVISION*)) (declare (integer start-revision) (list item-identifiers) (type (or null TopicC) reifier)) (or (and (reifier construct :revision start-revision) @@ -2306,7 +2313,7 @@ (defgeneric item-identifiers (construct &key revision) (:documentation "Returns the ItemIdentifierC-objects that correspond with the passed construct and the passed version.") - (:method ((construct ReifiableConstructC) &key (revision 0)) + (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'item-identifiers :start-revision revision))) (map 'list #'identifier assocs)))) @@ -2315,7 +2322,7 @@ (defgeneric reifier (construct &key revision) (:documentation "Returns the reifier-topic that corresponds with the passed construct and the passed version.") - (:method ((construct ReifiableConstructC) &key (revision 0)) + (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) (let ((assocs (filter-slot-value-by-revision construct 'reifier :start-revision revision))) (when assocs ;assocs must be nil or a list with exactly one item @@ -2333,7 +2340,8 @@ (let ((all-ids (map 'list #'identifier (slot-p construct 'item-identifiers))) (construct-to-be-merged - (let ((id-owner (identified-construct item-identifier))) + (let ((id-owner (identified-construct item-identifier + :revision revision))) (when (not (eql id-owner construct)) id-owner)))) (let ((merged-construct construct)) @@ -2381,8 +2389,9 @@ (:method ((construct ReifiableConstructC) (reifier-topic TopicC) &key (revision *TM-REVISION*)) (let ((merged-reifier-topic - (if (reifier construct) - (merge-constructs (reifier construct) reifier-topic) + (if (reifier construct :revision revision) + (merge-constructs (reifier construct :revision revision) + reifier-topic) reifier-topic))) (let ((all-constructs (let ((inner-construct (reified-construct merged-reifier-topic @@ -2427,7 +2436,7 @@
(defmethod get-all-identifiers-of-construct ((construct ReifiableConstructC) - &key (revision 0)) + &key (revision *TM-REVISION*)) (declare (integer revision)) (item-identifiers construct :revision revision))
@@ -2457,7 +2466,7 @@ &key start-revision) (: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)) + (:method ((construct TypableC) instance-of &key (start-revision *TM-REVISION*)) (declare (integer start-revision) (type (or null TopicC) instance-of)) (eql (instance-of construct :revision start-revision) instance-of))) @@ -2486,7 +2495,7 @@ (defgeneric equivalent-scopable-construct (construct themes &key start-revision) (: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)) + (:method ((construct ScopableC) themes &key (start-revision *TM-REVISION*)) (declare (integer start-revision) (list themes)) (not (set-exclusive-or (themes construct :revision start-revision) themes)))) @@ -2500,7 +2509,7 @@ (defgeneric themes (construct &key revision) (:documentation "Returns all topics that correspond with the given revision as a scope for the given topic.") - (:method ((construct ScopableC) &key (revision 0)) + (:method ((construct ScopableC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'themes :start-revision revision))) @@ -2561,7 +2570,7 @@ (defgeneric instance-of (construct &key revision) (:documentation "Returns the type topic that is set on the passed revision.") - (:method ((construct TypableC) &key (revision 0)) + (:method ((construct TypableC) &key (revision *TM-REVISION*)) (let ((valid-associations (filter-slot-value-by-revision construct 'instance-of :start-revision revision))) @@ -2626,8 +2635,8 @@
(defmethod equivalent-construct ((construct TopicMapC) - &key (start-revision 0) (reifier nil) - (item-identifiers nil)) + &key (start-revision *TM-REVISION*) + (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)) @@ -2664,12 +2673,14 @@ topic map?"))
-(defmethod in-topicmap ((tm TopicMapC) (top TopicC) &key (revision 0)) +(defmethod in-topicmap ((tm TopicMapC) (top TopicC) &key + (revision *TM-REVISION*)) (when (find-item-by-revision top revision) (find (internal-id top) (topics tm) :test #'= :key #'internal-id)))
-(defmethod in-topicmap ((tm TopicMapC) (ass AssociationC) &key (revision 0)) +(defmethod in-topicmap ((tm TopicMapC) (ass AssociationC) + &key (revision *TM-REVISION*)) (when (find-item-by-revision ass revision) (find (internal-id ass) (associations tm) :test #'= :key #'internal-id)))
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 Mon Mar 22 14:14:02 2010 @@ -417,44 +417,51 @@ (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) (top-3 (make-instance 'TopicC)) - (revision 100) - (revision-2 200)) - (setf d:*TM-REVISION* revision) - (is-false (get-item-by-id "any-top-id")) + (rev-0 0) + (rev-1 100) + (rev-2 200)) + (setf d:*TM-REVISION* rev-1) + (is-false (get-item-by-id "any-top-id" :revision rev-0)) (signals error (is-false (get-item-by-id "any-top-id" :xtm-id "any-xtm-id" :error-if-nil t))) - (signals error (is-false (get-item-by-id "any-top-id" :error-if-nil t))) + (signals error (is-false (get-item-by-id "any-top-id" :error-if-nil t + :revision rev-0))) (is-false (get-item-by-id "any-top-id" :xtm-id "any-xtm-id")) - (add-topic-identifier top-1 top-id-3-1 :revision revision) - (add-topic-identifier top-1 top-id-3-2 :revision revision) + (add-topic-identifier top-1 top-id-3-1 :revision rev-1) + (add-topic-identifier top-1 top-id-3-2 :revision rev-1) (signals duplicate-identifier-error - (get-item-by-id "topid-3" :xtm-id "xtm-id-3" :revision revision)) + (get-item-by-id "topid-3" :xtm-id "xtm-id-3" :revision rev-1)) (add-topic-identifier top-2 top-id-1) - (add-topic-identifier top-2 top-id-2 :revision revision-2) - (is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1"))) - (is (eql top-2 (get-item-by-id "topid-2" :xtm-id "xtm-id-2"))) + (add-topic-identifier top-2 top-id-2 :revision rev-2) + (is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1" + :revision rev-0))) + (is (eql top-2 (get-item-by-id "topid-2" :xtm-id "xtm-id-2" + :revision rev-0))) (is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1" :revision 500))) (is-false (get-item-by-id "topid-2" :xtm-id "xtm-id-2" - :revision revision)) - (delete-topic-identifier top-2 top-id-1 :revision revision-2) - (is-false (get-item-by-id "topid-1" :xtm-id "xtm-id-1")) + :revision rev-1)) + (delete-topic-identifier top-2 top-id-1 :revision rev-2) + (is-false (get-item-by-id "topid-1" :xtm-id "xtm-id-1" + :revision rev-0)) (is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1" - :revision revision))) - (add-topic-identifier top-3 top-id-1 :revision revision-2) + :revision rev-1))) + (add-topic-identifier top-3 top-id-1 :revision rev-2) (is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1" - :revision revision))) - (d::add-to-version-history top-3 :start-revision revision-2) - (is (eql top-3 (get-item-by-id "topid-1" :xtm-id "xtm-id-1"))) + :revision rev-1))) + (d::add-to-version-history top-3 :start-revision rev-2) + (is (eql top-3 (get-item-by-id "topid-1" :xtm-id "xtm-id-1" + :revision rev-0))) (is (eql top-3 (get-item-by-id (concatenate 'string "t" (write-to-string - (elephant::oid top-3)))))) + (elephant::oid top-3))) + :revision rev-0))) (is-false (get-item-by-id (concatenate 'string "t" (write-to-string (elephant::oid top-3))) - :revision revision))))) + :revision rev-1)))))
(test test-get-item-by-item-identifier () @@ -471,32 +478,35 @@ (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) (top-3 (make-instance 'TopicC)) - (revision 100) - (revision-2 200)) - (setf d:*TM-REVISION* revision) + (rev-0 0) + (rev-1 100) + (rev-2 200)) + (setf d:*TM-REVISION* rev-1) (is-false (get-item-by-id "any-ii-id")) (signals error (is-false (get-item-by-item-identifier - "any-ii-id" :error-if-nil t))) + "any-ii-id" :error-if-nil t + :revision rev-1))) (signals error (is-false (get-item-by-item-identifier - "any-ii-id" :error-if-nil t))) + "any-ii-id" :error-if-nil t + :revision rev-1))) (is-false (get-item-by-item-identifier "any-ii-id")) - (add-item-identifier top-1 ii-3-1 :revision revision) - (add-item-identifier top-1 ii-3-2 :revision revision) + (add-item-identifier top-1 ii-3-1 :revision rev-1) + (add-item-identifier top-1 ii-3-2 :revision rev-1) (signals duplicate-identifier-error - (get-item-by-item-identifier "ii-3" :revision revision)) + (get-item-by-item-identifier "ii-3" :revision rev-1)) (add-item-identifier top-2 ii-1) - (add-item-identifier top-2 ii-2 :revision revision-2) - (is (eql top-2 (get-item-by-item-identifier "ii-1"))) - (is (eql top-2 (get-item-by-item-identifier "ii-2"))) + (add-item-identifier top-2 ii-2 :revision rev-2) + (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision rev-0))) + (is (eql top-2 (get-item-by-item-identifier "ii-2" :revision rev-0))) (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision 500))) - (is-false (get-item-by-item-identifier "ii-2" :revision revision)) - (delete-item-identifier top-2 ii-1 :revision revision-2) - (is-false (get-item-by-item-identifier "ii-1")) - (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision revision))) - (add-item-identifier top-3 ii-1 :revision revision-2) - (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision revision))) - (d::add-to-version-history top-3 :start-revision revision-2) - (is (eql top-3 (get-item-by-item-identifier "ii-1")))))) + (is-false (get-item-by-item-identifier "ii-2" :revision rev-1)) + (delete-item-identifier top-2 ii-1 :revision rev-2) + (is-false (get-item-by-item-identifier "ii-1" :revision rev-0)) + (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision rev-1))) + (add-item-identifier top-3 ii-1 :revision rev-2) + (is (eql top-2 (get-item-by-item-identifier "ii-1" :revision rev-1))) + (d::add-to-version-history top-3 :start-revision rev-2) + (is (eql top-3 (get-item-by-item-identifier "ii-1" :revision rev-0))))))
(test test-get-item-by-locator () @@ -513,32 +523,35 @@ (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) (top-3 (make-instance 'TopicC)) - (revision 100) - (revision-2 200)) - (setf d:*TM-REVISION* revision) + (rev-0 0) + (rev-1 100) + (rev-2 200)) + (setf d:*TM-REVISION* rev-1) (is-false (get-item-by-id "any-sl-id")) (signals error (is-false (get-item-by-locator - "any-sl-id" :error-if-nil t))) + "any-sl-id" :error-if-nil t + :revision rev-0))) (signals error (is-false (get-item-by-locator - "any-sl-id" :error-if-nil t))) - (is-false (get-item-by-locator "any-sl-id")) - (add-locator top-1 sl-3-1 :revision revision) - (add-locator top-1 sl-3-2 :revision revision) + "any-sl-id" :error-if-nil t + :revision rev-0))) + (is-false (get-item-by-locator "any-sl-id" :revision rev-0)) + (add-locator top-1 sl-3-1 :revision rev-1) + (add-locator top-1 sl-3-2 :revision rev-1) (signals duplicate-identifier-error - (get-item-by-locator "sl-3" :revision revision)) + (get-item-by-locator "sl-3" :revision rev-1)) (add-locator top-2 sl-1) - (add-locator top-2 sl-2 :revision revision-2) - (is (eql top-2 (get-item-by-locator "sl-1"))) - (is (eql top-2 (get-item-by-locator "sl-2"))) + (add-locator top-2 sl-2 :revision rev-2) + (is (eql top-2 (get-item-by-locator "sl-1" :revision rev-0))) + (is (eql top-2 (get-item-by-locator "sl-2" :revision rev-0))) (is (eql top-2 (get-item-by-locator "sl-1" :revision 500))) - (is-false (get-item-by-locator "sl-2" :revision revision)) - (delete-locator top-2 sl-1 :revision revision-2) - (is-false (get-item-by-locator "sl-1")) - (is (eql top-2 (get-item-by-locator "sl-1" :revision revision))) - (add-locator top-3 sl-1 :revision revision-2) - (is (eql top-2 (get-item-by-locator "sl-1" :revision revision))) - (d::add-to-version-history top-3 :start-revision revision-2) - (is (eql top-3 (get-item-by-locator "sl-1")))))) + (is-false (get-item-by-locator "sl-2" :revision rev-1)) + (delete-locator top-2 sl-1 :revision rev-2) + (is-false (get-item-by-locator "sl-1" :revision rev-0)) + (is (eql top-2 (get-item-by-locator "sl-1" :revision rev-1))) + (add-locator top-3 sl-1 :revision rev-2) + (is (eql top-2 (get-item-by-locator "sl-1" :revision rev-1))) + (d::add-to-version-history top-3 :start-revision rev-2) + (is (eql top-3 (get-item-by-locator "sl-1" :revision rev-0))))))
(test test-get-item-by-psi () @@ -555,32 +568,35 @@ (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) (top-3 (make-instance 'TopicC)) - (revision 100) - (revision-2 200)) - (setf d:*TM-REVISION* revision) + (rev-0 0) + (rev-1 100) + (rev-2 200)) + (setf d:*TM-REVISION* rev-1) (is-false (get-item-by-id "any-psi-id")) (signals error (is-false (get-item-by-locator - "any-psi-id" :error-if-nil t))) + "any-psi-id" :error-if-nil t + :revision rev-0))) (signals error (is-false (get-item-by-locator - "any-psi-id" :error-if-nil t))) + "any-psi-id" :error-if-nil t + :revision rev-0))) (is-false (get-item-by-locator "any-psi-id")) - (add-psi top-1 psi-3-1 :revision revision) - (add-psi top-1 psi-3-2 :revision revision) + (add-psi top-1 psi-3-1 :revision rev-1) + (add-psi top-1 psi-3-2 :revision rev-1) (signals duplicate-identifier-error - (get-item-by-locator "psi-3" :revision revision)) + (get-item-by-locator "psi-3" :revision rev-1)) (add-psi top-2 psi-1) - (add-psi top-2 psi-2 :revision revision-2) - (is (eql top-2 (get-item-by-locator "psi-1"))) - (is (eql top-2 (get-item-by-locator "psi-2"))) + (add-psi top-2 psi-2 :revision rev-2) + (is (eql top-2 (get-item-by-locator "psi-1" :revision rev-0))) + (is (eql top-2 (get-item-by-locator "psi-2" :revision rev-0))) (is (eql top-2 (get-item-by-locator "psi-1" :revision 500))) - (is-false (get-item-by-locator "psi-2" :revision revision)) - (delete-psi top-2 psi-1 :revision revision-2) - (is-false (get-item-by-locator "psi-1")) - (is (eql top-2 (get-item-by-locator "psi-1" :revision revision))) - (add-psi top-3 psi-1 :revision revision-2) - (is (eql top-2 (get-item-by-locator "psi-1" :revision revision))) - (d::add-to-version-history top-3 :start-revision revision-2) - (is (eql top-3 (get-item-by-locator "psi-1")))))) + (is-false (get-item-by-locator "psi-2" :revision rev-1)) + (delete-psi top-2 psi-1 :revision rev-2) + (is-false (get-item-by-locator "psi-1" :revision rev-0)) + (is (eql top-2 (get-item-by-locator "psi-1" :revision rev-1))) + (add-psi top-3 psi-1 :revision rev-2) + (is (eql top-2 (get-item-by-locator "psi-1" :revision rev-1))) + (d::add-to-version-history top-3 :start-revision rev-2) + (is (eql top-3 (get-item-by-locator "psi-1" :revision rev-0))))))
(test test-ReifiableConstructC () @@ -621,81 +637,82 @@ (occ-2 (make-instance 'OccurrenceC)) (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) - (revision-1 100) - (revision-2 200) - (revision-3 300) - (revision-4 400) - (revision-5 500) - (revision-6 600) - (revision-7 700) - (revision-8 800)) - (setf *TM-REVISION* revision-1) - (is-false (parent occ-1)) - (is-false (occurrences top-1)) - (add-occurrence top-1 occ-1 :revision revision-1) + (rev-0 0) + (rev-1 100) + (rev-2 200) + (rev-3 300) + (rev-4 400) + (rev-5 500) + (rev-6 600) + (rev-7 700) + (rev-8 800)) + (setf *TM-REVISION* rev-1) + (is-false (parent occ-1 :revision rev-0)) + (is-false (occurrences top-1 :revision rev-0)) + (add-occurrence top-1 occ-1 :revision rev-1) (is (= (length (d::versions top-1)) 1)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-1) + (and (= (d::start-revision vi) rev-1) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list occ-1) - (occurrences top-1))) 1)) - (add-occurrence top-1 occ-2 :revision revision-2) + (occurrences top-1 :revision rev-0))) 1)) + (add-occurrence top-1 occ-2 :revision rev-2) (is (= (length (d::versions top-1)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-2) + (and (= (d::start-revision vi) rev-2) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list occ-1 occ-2) - (occurrences top-1))) 2)) + (occurrences top-1 :revision rev-0))) 2)) (is (= (length (union (list occ-1) - (occurrences top-1 :revision revision-1))) 1)) - (add-occurrence top-1 occ-2 :revision revision-3) + (occurrences top-1 :revision rev-1))) 1)) + (add-occurrence top-1 occ-2 :revision rev-3) (is (= (length (d::slot-p top-1 'd::occurrences)) 2)) - (delete-occurrence top-1 occ-1 :revision revision-4) + (delete-occurrence top-1 occ-1 :revision rev-4) (is (= (length (d::versions top-1)) 4)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-4) + (and (= (d::start-revision vi) rev-4) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list occ-2) - (occurrences top-1 :revision revision-4))) 1)) + (occurrences top-1 :revision rev-4))) 1)) (is (= (length (union (list occ-2) - (occurrences top-1))) 1)) + (occurrences top-1 :revision rev-0))) 1)) (is (= (length (union (list occ-1 occ-2) - (occurrences top-1 :revision revision-2))) 2)) - (add-occurrence top-1 occ-1 :revision revision-4) + (occurrences top-1 :revision rev-2))) 2)) + (add-occurrence top-1 occ-1 :revision rev-4) (is (= (length (union (list occ-2 occ-1) - (occurrences top-1))) 2)) - (signals error (add-occurrence top-2 occ-1 :revision revision-4)) - (delete-occurrence top-1 occ-1 :revision revision-5) + (occurrences top-1 :revision rev-0))) 2)) + (signals error (add-occurrence top-2 occ-1 :revision rev-4)) + (delete-occurrence top-1 occ-1 :revision rev-5) (is (= (length (union (list occ-2) - (occurrences top-1 :revision revision-5))) 1)) - (add-occurrence top-2 occ-1 :revision revision-5) - (is (eql (parent occ-1) top-2)) - (is (eql (parent occ-1 :revision revision-2) top-1)) - (delete-parent occ-2 top-1 :revision revision-4) - (is-false (parent occ-2 :revision revision-4)) - (is (eql top-1 (parent occ-2 :revision revision-3))) - (add-parent occ-2 top-1 :revision revision-5) - (is-false (parent occ-2 :revision revision-4)) - (is (eql top-1 (parent occ-2))) - (delete-parent occ-2 top-1 :revision revision-6) - (add-parent occ-2 top-2 :revision revision-7) + (occurrences top-1 :revision rev-5))) 1)) + (add-occurrence top-2 occ-1 :revision rev-5) + (is (eql (parent occ-1 :revision rev-0) top-2)) + (is (eql (parent occ-1 :revision rev-2) top-1)) + (delete-parent occ-2 top-1 :revision rev-4) + (is-false (parent occ-2 :revision rev-4)) + (is (eql top-1 (parent occ-2 :revision rev-3))) + (add-parent occ-2 top-1 :revision rev-5) + (is-false (parent occ-2 :revision rev-4)) + (is (eql top-1 (parent occ-2 :revision rev-0))) + (delete-parent occ-2 top-1 :revision rev-6) + (add-parent occ-2 top-2 :revision rev-7) (is (= (length (d::versions top-2)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-7) + (and (= (d::start-revision vi) rev-7) (= (d::end-revision vi) 0))) (d::versions top-2))) - (delete-parent occ-2 top-2 :revision revision-8) + (delete-parent occ-2 top-2 :revision rev-8) (is (= (length (d::versions top-2)) 3)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-8) + (and (= (d::start-revision vi) rev-8) (= (d::end-revision vi) 0))) (d::versions top-2))) - (is-false (parent occ-2)) - (add-parent occ-2 top-1 :revision revision-8) - (is (eql top-1 (parent occ-2)))))) + (is-false (parent occ-2 :revision rev-0)) + (add-parent occ-2 top-1 :revision rev-8) + (is (eql top-1 (parent occ-2 :revision rev-0))))))
(test test-VariantC () @@ -705,56 +722,57 @@ (v-2 (make-instance 'VariantC)) (name-1 (make-instance 'NameC)) (name-2 (make-instance 'NameC)) - (revision-1 100) - (revision-2 200) - (revision-3 300) - (revision-4 400) - (revision-5 500) - (revision-6 600) - (revision-7 700) - (revision-8 800)) - (setf *TM-REVISION* revision-1) - (is-false (parent v-1)) - (is-false (variants name-1)) - (add-variant name-1 v-1 :revision revision-1) + (rev-0 0) + (rev-1 100) + (rev-2 200) + (rev-3 300) + (rev-4 400) + (rev-5 500) + (rev-6 600) + (rev-7 700) + (rev-8 800)) + (setf *TM-REVISION* rev-1) + (is-false (parent v-1 :revision rev-0)) + (is-false (variants name-1 :revision rev-0)) + (add-variant name-1 v-1 :revision rev-1) (is (= (length (union (list v-1) - (variants name-1))) 1)) - (add-variant name-1 v-2 :revision revision-2) + (variants name-1 :revision rev-0))) 1)) + (add-variant name-1 v-2 :revision rev-2) (is (= (length (union (list v-1 v-2) - (variants name-1))) 2)) + (variants name-1 :revision rev-0))) 2)) (is (= (length (union (list v-1) - (variants name-1 :revision revision-1))) 1)) - (add-variant name-1 v-2 :revision revision-3) + (variants name-1 :revision rev-1))) 1)) + (add-variant name-1 v-2 :revision rev-3) (is (= (length (d::slot-p name-1 'd::variants)) 2)) - (delete-variant name-1 v-1 :revision revision-4) + (delete-variant name-1 v-1 :revision rev-4) (is (= (length (union (list v-2) - (variants name-1 :revision revision-4))) 1)) + (variants name-1 :revision rev-4))) 1)) (is (= (length (union (list v-2) - (variants name-1))) 1)) + (variants name-1 :revision rev-0))) 1)) (is (= (length (union (list v-1 v-2) - (variants name-1 :revision revision-2))) 2)) - (add-variant name-1 v-1 :revision revision-4) + (variants name-1 :revision rev-2))) 2)) + (add-variant name-1 v-1 :revision rev-4) (is (= (length (union (list v-2 v-1) - (variants name-1))) 2)) - (signals error (add-variant name-2 v-1 :revision revision-4)) - (delete-variant name-1 v-1 :revision revision-5) + (variants name-1 :revision rev-0))) 2)) + (signals error (add-variant name-2 v-1 :revision rev-4)) + (delete-variant name-1 v-1 :revision rev-5) (is (= (length (union (list v-2) - (variants name-1 :revision revision-5))) 1)) - (add-variant name-2 v-1 :revision revision-5) - (is (eql (parent v-1) name-2)) - (is (eql (parent v-1 :revision revision-2) name-1)) - (delete-parent v-2 name-1 :revision revision-4) - (is-false (parent v-2 :revision revision-4)) - (is (eql name-1 (parent v-2 :revision revision-3))) - (add-parent v-2 name-1 :revision revision-5) - (is-false (parent v-2 :revision revision-4)) - (is (eql name-1 (parent v-2))) - (delete-parent v-2 name-1 :revision revision-6) - (add-parent v-2 name-2 :revision revision-7) - (delete-parent v-2 name-2 :revision revision-8) - (is-false (parent v-2)) - (add-parent v-2 name-1 :revision revision-8) - (is (eql name-1 (parent v-2)))))) + (variants name-1 :revision rev-5))) 1)) + (add-variant name-2 v-1 :revision rev-5) + (is (eql (parent v-1 :revision rev-0) name-2)) + (is (eql (parent v-1 :revision rev-2) name-1)) + (delete-parent v-2 name-1 :revision rev-4) + (is-false (parent v-2 :revision rev-4)) + (is (eql name-1 (parent v-2 :revision rev-3))) + (add-parent v-2 name-1 :revision rev-5) + (is-false (parent v-2 :revision rev-4)) + (is (eql name-1 (parent v-2 :revision rev-0))) + (delete-parent v-2 name-1 :revision rev-6) + (add-parent v-2 name-2 :revision rev-7) + (delete-parent v-2 name-2 :revision rev-8) + (is-false (parent v-2 :revision rev-0)) + (add-parent v-2 name-1 :revision rev-8) + (is (eql name-1 (parent v-2 :revision rev-0))))))
(test test-NameC () @@ -764,81 +782,82 @@ (name-2 (make-instance 'NameC)) (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) - (revision-1 100) - (revision-2 200) - (revision-3 300) - (revision-4 400) - (revision-5 500) - (revision-6 600) - (revision-7 700) - (revision-8 800)) - (setf *TM-REVISION* revision-1) - (is-false (parent name-1)) - (is-false (names top-1)) - (add-name top-1 name-1 :revision revision-1) + (rev-0 0) + (rev-1 100) + (rev-2 200) + (rev-3 300) + (rev-4 400) + (rev-5 500) + (rev-6 600) + (rev-7 700) + (rev-8 800)) + (setf *TM-REVISION* rev-1) + (is-false (parent name-1 :revision rev-0)) + (is-false (names top-1 :revision rev-0)) + (add-name top-1 name-1 :revision rev-1) (is (= (length (d::versions top-1)) 1)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-1) + (and (= (d::start-revision vi) rev-1) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list name-1) - (names top-1))) 1)) - (add-name top-1 name-2 :revision revision-2) + (names top-1 :revision rev-0))) 1)) + (add-name top-1 name-2 :revision rev-2) (is (= (length (d::versions top-1)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-2) + (and (= (d::start-revision vi) rev-2) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list name-1 name-2) - (names top-1))) 2)) + (names top-1 :revision rev-0))) 2)) (is (= (length (union (list name-1) - (names top-1 :revision revision-1))) 1)) - (add-name top-1 name-2 :revision revision-3) + (names top-1 :revision rev-1))) 1)) + (add-name top-1 name-2 :revision rev-3) (is (= (length (d::slot-p top-1 'd::names)) 2)) - (delete-name top-1 name-1 :revision revision-4) + (delete-name top-1 name-1 :revision rev-4) (is (= (length (d::versions top-1)) 4)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-4) + (and (= (d::start-revision vi) rev-4) (= (d::end-revision vi) 0))) (d::versions top-1))) (is (= (length (union (list name-2) - (names top-1 :revision revision-4))) 1)) + (names top-1 :revision rev-4))) 1)) (is (= (length (union (list name-2) - (names top-1))) 1)) + (names top-1 :revision rev-0))) 1)) (is (= (length (union (list name-1 name-2) - (names top-1 :revision revision-2))) 2)) - (add-name top-1 name-1 :revision revision-4) + (names top-1 :revision rev-2))) 2)) + (add-name top-1 name-1 :revision rev-4) (is (= (length (union (list name-2 name-1) - (names top-1))) 2)) - (signals error (add-name top-2 name-1 :revision revision-4)) - (delete-name top-1 name-1 :revision revision-5) + (names top-1 :revision rev-0))) 2)) + (signals error (add-name top-2 name-1 :revision rev-4)) + (delete-name top-1 name-1 :revision rev-5) (is (= (length (union (list name-2) - (names top-1 :revision revision-5))) 1)) - (add-name top-2 name-1 :revision revision-5) - (is (eql (parent name-1) top-2)) - (is (eql (parent name-1 :revision revision-2) top-1)) - (delete-parent name-2 top-1 :revision revision-4) - (is-false (parent name-2 :revision revision-4)) - (is (eql top-1 (parent name-2 :revision revision-3))) - (add-parent name-2 top-1 :revision revision-5) - (is-false (parent name-2 :revision revision-4)) - (is (eql top-1 (parent name-2))) - (delete-parent name-2 top-1 :revision revision-6) - (add-parent name-2 top-2 :revision revision-7) + (names top-1 :revision rev-5))) 1)) + (add-name top-2 name-1 :revision rev-5) + (is (eql (parent name-1 :revision rev-0) top-2)) + (is (eql (parent name-1 :revision rev-2) top-1)) + (delete-parent name-2 top-1 :revision rev-4) + (is-false (parent name-2 :revision rev-4)) + (is (eql top-1 (parent name-2 :revision rev-3))) + (add-parent name-2 top-1 :revision rev-5) + (is-false (parent name-2 :revision rev-4)) + (is (eql top-1 (parent name-2 :revision rev-0))) + (delete-parent name-2 top-1 :revision rev-6) + (add-parent name-2 top-2 :revision rev-7) (is (= (length (d::versions top-2)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-7) + (and (= (d::start-revision vi) rev-7) (= (d::end-revision vi) 0))) (d::versions top-2))) - (delete-parent name-2 top-2 :revision revision-8) + (delete-parent name-2 top-2 :revision rev-8) (is (= (length (d::versions top-2)) 3)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-8) + (and (= (d::start-revision vi) rev-8) (= (d::end-revision vi) 0))) (d::versions top-2))) - (is-false (parent name-2)) - (add-parent name-2 top-1 :revision revision-8) - (is (eql top-1 (parent name-2)))))) + (is-false (parent name-2 :revision rev-0)) + (add-parent name-2 top-1 :revision rev-8) + (is (eql top-1 (parent name-2 :revision rev-0))))))
(test test-TypableC () @@ -848,31 +867,31 @@ (name-2 (make-instance 'NameC)) (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) + (revision-0 0) (revision-0-5 50) (revision-1 100) (revision-2 200) (revision-3 300)) (setf *TM-REVISION* revision-1) - (is-false (instance-of name-1)) + (is-false (instance-of name-1 :revision revision-0)) (add-type name-1 top-1) (is (eql top-1 (instance-of name-1))) (is-false (instance-of name-1 :revision revision-0-5)) (is (eql top-1 (instance-of name-1 :revision revision-2))) - (signals error (add-type name-1 top-2)) + (signals error (add-type name-1 top-2 :revision revision-0)) (add-type name-2 top-1 :revision revision-2) (is (= (length (union (list name-1 name-2) - (used-as-type top-1))) 2)) + (used-as-type top-1 :revision revision-0))) 2)) (is (= (length (union (list name-1) - (used-as-type top-1 - :revision revision-1))) 1)) + (used-as-type top-1 :revision revision-1))) 1)) (delete-type name-1 top-1 :revision revision-3) - (is-false (instance-of name-1)) + (is-false (instance-of name-1 :revision revision-0)) (is (= (length (union (list name-2) - (used-as-type top-1))) 1)) + (used-as-type top-1 :revision revision-0))) 1)) (add-type name-1 top-1 :revision revision-3) - (is (eql top-1 (instance-of name-1))) + (is (eql top-1 (instance-of name-1 :revision revision-0))) (is (= (length (union (list name-1 name-2) - (used-as-type top-1))) 2)) + (used-as-type top-1 :revision revision-0))) 2)) (is (= (length (slot-value top-1 'd::used-as-type)) 2)))))
@@ -883,43 +902,44 @@ (occ-2 (make-instance 'OccurrenceC)) (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) + (revision-0 0) (revision-1 100) (revision-2 200) (revision-3 300)) (setf *TM-REVISION* revision-1) - (is-false (themes occ-1)) - (is-false (used-as-theme top-1)) + (is-false (themes occ-1 :revision revision-0)) + (is-false (used-as-theme top-1 :revision revision-0)) (add-theme occ-1 top-1) (is (= (length (union (list top-1) - (themes occ-1))) 1)) + (themes occ-1 :revision revision-0))) 1)) (is (= (length (union (list occ-1) - (used-as-theme top-1))) 1)) + (used-as-theme top-1 :revision revision-0))) 1)) (delete-theme occ-1 top-1 :revision revision-2) (is (= (length (union (list top-1) (themes occ-1 :revision revision-1))) 1)) - (is-false (themes occ-1)) - (is-false (used-as-theme top-1)) + (is-false (themes occ-1 :revision revision-0)) + (is-false (used-as-theme top-1 :revision revision-0)) (is-false (themes occ-1 :revision revision-2)) (add-theme occ-1 top-1 :revision revision-3) (is (= (length (union (list top-1) - (themes occ-1))) 1)) + (themes occ-1 :revision revision-0))) 1)) (is (= (length (slot-value occ-1 'd::themes)) 1)) (add-theme occ-1 top-2 :revision revision-2) (is (= (length (union (list top-1 top-2) - (themes occ-1))) 2)) + (themes occ-1 :revision revision-0))) 2)) (is (= (length (union (list top-2) (themes occ-1 :revision revision-2))) 1)) (is (= (length (union (list top-1 top-2) - (themes occ-1))) 2)) + (themes occ-1 :revision revision-0))) 2)) (add-theme occ-2 top-2 :revision revision-3) (is (= (length (union (list top-1 top-2) - (themes occ-1))) 2)) + (themes occ-1 :revision revision-0))) 2)) (is (= (length (union (list top-2) - (themes occ-2))) 1)) + (themes occ-2 :revision revision-0))) 1)) (is (= (length (union (list occ-1) - (used-as-theme top-1))) 1)) + (used-as-theme top-1 :revision revision-0))) 1)) (is (= (length (union (list occ-1 occ-2) - (used-as-theme top-2))) 2)) + (used-as-theme top-2 :revision revision-0))) 2)) (is (= (length (slot-value occ-1 'd::themes)) 2)) (is (= (length (slot-value occ-2 'd::themes)) 1)) (is (= (length (slot-value top-1 'd::used-as-theme)) 1)) @@ -933,67 +953,68 @@ (role-2 (make-instance 'RoleC)) (assoc-1 (make-instance 'AssociationC)) (assoc-2 (make-instance 'AssociationC)) - (revision-1 100) - (revision-2 200) - (revision-3 300) - (revision-4 400)) - (setf *TM-REVISION* revision-1) - (is-false (roles assoc-1)) - (is-false (parent role-1)) + (rev-0 0) + (rev-1 100) + (rev-2 200) + (rev-3 300) + (rev-4 400)) + (setf *TM-REVISION* rev-1) + (is-false (roles assoc-1 :revision rev-0)) + (is-false (parent role-1 :revision rev-0)) (add-parent role-1 assoc-1) (is (= (length (d::versions assoc-1)) 1)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-1) + (and (= (d::start-revision vi) rev-1) (= (d::end-revision vi) 0))) (d::versions assoc-1))) - (is (eql (parent role-1 :revision revision-1) assoc-1)) + (is (eql (parent role-1 :revision rev-1) assoc-1)) (is (= (length (union (list role-1) (roles assoc-1))) 1)) - (add-role assoc-1 role-2 :revision revision-2) + (add-role assoc-1 role-2 :revision rev-2) (is (= (length (d::versions assoc-1)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-2) + (and (= (d::start-revision vi) rev-2) (= (d::end-revision vi) 0))) (d::versions assoc-1))) (is (= (length (union (list role-1 role-2) - (roles assoc-1))) 2)) + (roles assoc-1 :revision rev-0))) 2)) (is (= (length (union (list role-1) - (roles assoc-1 :revision revision-1))) 1)) - (is (eql (parent role-1) assoc-1)) - (is (eql (parent role-2 :revision revision-2) assoc-1)) - (is-false (parent role-2 :revision revision-1)) - (signals error (add-parent role-2 assoc-2 :revision revision-2)) - (delete-role assoc-1 role-1 :revision revision-3) + (roles assoc-1 :revision rev-1))) 1)) + (is (eql (parent role-1 :revision rev-0) assoc-1)) + (is (eql (parent role-2 :revision rev-2) assoc-1)) + (is-false (parent role-2 :revision rev-1)) + (signals error (add-parent role-2 assoc-2 :revision rev-2)) + (delete-role assoc-1 role-1 :revision rev-3) (is (= (length (d::versions assoc-1)) 3)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-3) + (and (= (d::start-revision vi) rev-3) (= (d::end-revision vi) 0))) (d::versions assoc-1))) - (is-false (parent role-1)) + (is-false (parent role-1 :revision rev-0)) (is (= (length (union (list role-2) - (roles assoc-1))) 1)) - (delete-parent role-2 assoc-1 :revision revision-3) - (is-false (parent role-2)) - (is (eql assoc-1 (parent role-2 :revision revision-2))) - (is-false (roles assoc-1)) - (add-role assoc-2 role-1 :revision revision-3) - (add-parent role-2 assoc-2 :revision revision-3) - (is (eql (parent role-2) assoc-2)) + (roles assoc-1 :revision rev-0))) 1)) + (delete-parent role-2 assoc-1 :revision rev-3) + (is-false (parent role-2 :revision rev-0)) + (is (eql assoc-1 (parent role-2 :revision rev-2))) + (is-false (roles assoc-1 :revision rev-0)) + (add-role assoc-2 role-1 :revision rev-3) + (add-parent role-2 assoc-2 :revision rev-3) + (is (eql (parent role-2 :revision rev-0) assoc-2)) (is (= (length (union (list role-1 role-2) (roles assoc-2))) 2)) - (add-role assoc-2 role-1 :revision revision-3) - (add-parent role-2 assoc-2 :revision revision-3) - (is (eql (parent role-2) assoc-2)) + (add-role assoc-2 role-1 :revision rev-3) + (add-parent role-2 assoc-2 :revision rev-3) + (is (eql (parent role-2 :revision rev-0) assoc-2)) (is (= (length (union (list role-1 role-2) - (roles assoc-2))) 2)) + (roles assoc-2 :revision rev-0))) 2)) (is (= (length (slot-value assoc-1 'roles)) 2)) (is (= (length (slot-value assoc-2 'roles)) 2)) (is (= (length (slot-value role-1 'parent)) 2)) (is (= (length (slot-value role-2 'parent)) 2)) - (delete-parent role-1 assoc-2 :revision revision-4) + (delete-parent role-1 assoc-2 :revision rev-4) (is (= (length (d::versions assoc-2)) 2)) (is-true (find-if #'(lambda(vi) - (and (= (d::start-revision vi) revision-4) + (and (= (d::start-revision vi) rev-4) (= (d::end-revision vi) 0))) (d::versions assoc-2))))))
@@ -1005,35 +1026,36 @@ (role-2 (make-instance 'RoleC)) (top-1 (make-instance 'TopicC)) (top-2 (make-instance 'TopicC)) + (revision-0 0) (revision-0-5 50) (revision-1 100) (revision-2 200) (revision-3 300)) (setf *TM-REVISION* revision-1) - (is-false (player role-1)) + (is-false (player role-1 :revision revision-0)) (add-player role-1 top-1) - (is (eql top-1 (player role-1))) + (is (eql top-1 (player role-1 :revision revision-0))) (is-false (player role-1 :revision revision-0-5)) (is (eql top-1 (player role-1 :revision revision-2))) (add-player role-1 top-1) - (is (eql top-1 (player role-1))) + (is (eql top-1 (player role-1 :revision revision-0))) (is-false (player role-1 :revision revision-0-5)) (is (eql top-1 (player role-1 :revision revision-2))) (signals error (add-player role-1 top-2)) (add-player role-2 top-1 :revision revision-2) (is (= (length (union (list role-1 role-2) - (player-in-roles top-1))) 2)) + (player-in-roles top-1 :revision revision-0))) 2)) (is (= (length (union (list role-1) (player-in-roles top-1 :revision revision-1))) 1)) (delete-player role-1 top-1 :revision revision-3) - (is-false (player role-1)) + (is-false (player role-1 :revision revision-0)) (is (= (length (union (list role-2) - (player-in-roles top-1))) 1)) + (player-in-roles top-1 :revision revision-0))) 1)) (add-player role-1 top-1 :revision revision-3) - (is (eql top-1 (player role-1))) + (is (eql top-1 (player role-1 :revision revision-0))) (is (= (length (union (list role-1 role-2) - (player-in-roles top-1))) 2)) + (player-in-roles top-1 :revision revision-0))) 2)) (is (= (length (slot-value top-1 'd::player-in-roles)) 2)))))
@@ -1226,6 +1248,7 @@ (reifier-1 (make-instance 'TopicC)) (reifier-2 (make-instance 'TopicC)) (ii-1 (make-instance 'ItemIdentifierC :uri "ii-1")) + (revision-0 0) (revision-1 100) (revision-2 200)) (setf *TM-REVISION* revision-1) @@ -1253,7 +1276,7 @@ (is (= (length (elephant:get-instances-by-class 'd::ReifierAssociationC)) 1)) (is (= (length (union (list ii-1) (item-identifiers rc-2))) 1)) - (is (eql reifier-1 (reifier rc-2))) + (is (eql reifier-1 (reifier rc-2 :revision revision-0))) (delete-construct ii-1) (delete-construct reifier-1) (is (= (length (elephant:get-instances-by-class 'd::ReifiableConstructC))
-
Lukas Giessmann