[isidorus-cvs] r245 - in branches/new-datamodel/src: model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Mar 22 16:24:54 UTC 2010
Author: lgiessmann
Date: Mon Mar 22 12:24:54 2010
New Revision: 245
Log:
new-datamodel: added "add-to-version-history" to all "add-<item>" and "delete-<item>" that are defined for "VersionedConstructC"
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 12:24:54 2010
@@ -171,8 +171,6 @@
;;TODO: implement merge-construct -> ReifiableConstructC -> ...
;; the method should merge two constructs that are inherited from
;; ReifiableConstructC
-;;TODO: implement find-item-by-revision for all classes that don't have their
-;; one revision-infos --> PointerC, CharacteristicC, RoleC
;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -747,6 +745,16 @@
;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defgeneric delete-parent (construct parent-construct &key revision)
+ (:documentation "Sets the assoication-object between the passed
+ constructs as marded-as-deleted."))
+
+
+(defgeneric add-parent (construct parent-construct &key revision)
+ (:documentation "Adds the parent-construct (TopicC or NameC) in form of
+ a corresponding association to the given object."))
+
+
(defgeneric find-item-by-revision (construct revision
&optional parent-construct)
(:documentation "Returns the given object if it exists in the passed
@@ -1283,6 +1291,7 @@
return ti-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -1338,6 +1347,7 @@
return psi-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -1394,6 +1404,7 @@
return loc-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -1452,6 +1463,7 @@
return name-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -1501,6 +1513,7 @@
return occ-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -1773,55 +1786,55 @@
(parent-construct (first valid-associations))))))
-(defgeneric add-parent (construct parent-construct &key revision)
- (:documentation "Adds the parent-construct (TopicC or NameC) in form of
- a corresponding association to the given object.")
- (:method ((construct CharacteristicC) (parent-construct ReifiableConstructC)
- &key (revision *TM-REVISION*))
- (let ((already-set-parent (parent construct :revision revision))
- (same-parent-assoc ;should contain a object that was marked as deleted
- (loop for parent-assoc in (slot-p construct 'parent)
- when (eql parent-construct (parent-construct parent-assoc))
- return parent-assoc)))
- (when (and already-set-parent
- (not (eql already-set-parent parent-construct)))
- (error "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
- construct parent-construct already-set-parent))
- (cond (already-set-parent
- (let ((parent-assoc
- (loop for parent-assoc in (slot-p construct 'parent)
- when (eql parent-construct
- (parent-construct parent-assoc))
- return parent-assoc)))
- (add-to-version-history parent-assoc :start-revision revision)))
- (same-parent-assoc
- (add-to-version-history same-parent-assoc :start-revision revision))
- (t
- (let ((association-type (cond ((typep construct 'OccurrenceC)
- 'OccurrenceAssociationC)
- ((typep construct 'NameC)
- 'NameAssociationC)
- (t
- 'VariantAssociationC))))
- (make-construct association-type
- :characteristic construct
- :parent-construct parent-construct
- :start-revision revision)))))
- construct))
+(defmethod add-parent ((construct CharacteristicC)
+ (parent-construct ReifiableConstructC)
+ &key (revision *TM-REVISION*))
+ (let ((already-set-parent (parent construct :revision revision))
+ (same-parent-assoc ;should contain a object that was marked as deleted
+ (loop for parent-assoc in (slot-p construct 'parent)
+ when (eql parent-construct (parent-construct parent-assoc))
+ return parent-assoc)))
+ (when (and already-set-parent
+ (not (eql already-set-parent parent-construct)))
+ (error "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
+ construct parent-construct already-set-parent))
+ (cond (already-set-parent
+ (let ((parent-assoc
+ (loop for parent-assoc in (slot-p construct 'parent)
+ when (eql parent-construct
+ (parent-construct parent-assoc))
+ return parent-assoc)))
+ (add-to-version-history parent-assoc :start-revision revision)))
+ (same-parent-assoc
+ (add-to-version-history same-parent-assoc :start-revision revision))
+ (t
+ (let ((association-type (cond ((typep construct 'OccurrenceC)
+ 'OccurrenceAssociationC)
+ ((typep construct 'NameC)
+ 'NameAssociationC)
+ (t
+ 'VariantAssociationC))))
+ (make-construct association-type
+ :characteristic construct
+ :parent-construct parent-construct
+ :start-revision revision)))))
+ (when (typep parent-construct 'VersionedConstructC)
+ (add-to-version-history parent-construct :start-revision revision))
+ construct)
-(defgeneric delete-parent (construct parent-construct &key revision)
- (:documentation "Sets the assoication-object between the passed
- constructs as marded-as-deleted.")
- (:method ((construct CharacteristicC) (parent-construct ReifiableConstructC)
- &key (revision (error "From delete-parent(): revision must be set")))
- (let ((assoc-to-delete
- (loop for parent-assoc in (slot-p construct 'parent)
- when (eql (parent-construct parent-assoc) parent-construct)
- return parent-assoc)))
- (when assoc-to-delete
- (mark-as-deleted assoc-to-delete :revision revision))
- construct)))
+(defmethod delete-parent ((construct CharacteristicC)
+ (parent-construct ReifiableConstructC)
+ &key (revision (error "From delete-parent(): revision must be set")))
+ (let ((assoc-to-delete
+ (loop for parent-assoc in (slot-p construct 'parent)
+ when (eql (parent-construct parent-assoc) parent-construct)
+ return parent-assoc)))
+ (when assoc-to-delete
+ (mark-as-deleted assoc-to-delete :revision revision))
+ (when (typep parent-construct 'VersionedConstructC)
+ (add-to-version-history parent-construct :start-revision revision))
+ construct))
;;; OccurrenceC
@@ -2037,6 +2050,7 @@
return role-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history construct :start-revision revision)
construct)))
@@ -2155,6 +2169,7 @@
return parent-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (add-to-version-history parent-construct :start-revision revision)
construct))
@@ -2337,9 +2352,7 @@
:parent-construct construct
:identifier item-identifier
:start-revision revision)))
- (when (or (typep merged-construct 'TopicC)
- (typep merged-construct 'AssociationC)
- (typep merged-construct 'TopicMapC))
+ (when (typep construct 'VersionedConstructC)
(add-to-version-history merged-construct :start-revision revision))
merged-construct))))
@@ -2354,6 +2367,8 @@
return ii-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (when (typep construct 'VersionedConstructC)
+ (add-to-version-history construct :start-revision revision))
construct)))
@@ -2391,9 +2406,7 @@
:reifiable-construct construct
:reifier-topic merged-reifier-topic
:start-revision revision)))
- (when (or (typep merged-construct 'TopicC)
- (typep merged-construct 'AssociationC)
- (typep merged-construct 'TopicMapC))
+ (when (typep construct 'VersionedConstructC)
(add-to-version-history merged-construct :start-revision revision))
merged-construct)))))
@@ -2408,6 +2421,8 @@
return reifier-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (when (typep construct 'VersionedConstructC)
+ (add-to-version-history construct :start-revision revision))
construct)))
@@ -2509,7 +2524,7 @@
:theme-topic theme-topic
:scopable-construct construct
:start-revision revision)))
- (when (typep construct 'AssociationC)
+ (when (typep construct 'VersionedConstructC)
(add-to-version-history construct :start-revision revision))
construct))
@@ -2524,6 +2539,8 @@
return theme-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (when (typep construct 'VersionedConstructC)
+ (add-to-version-history construct :start-revision revision))
construct)))
@@ -2580,7 +2597,7 @@
:type-topic type-topic
:typable-construct construct
:start-revision revision))))
- (when (typep construct 'AssociationC)
+ (when (typep construct 'VersionedConstructC)
(add-to-version-history construct :start-revision revision))
construct))
@@ -2596,6 +2613,8 @@
return type-assoc)))
(when assoc-to-delete
(mark-as-deleted assoc-to-delete :revision revision))
+ (when (typep construct 'VersionedConstructC)
+ (add-to-version-history construct :start-revision revision))
construct)))
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 12:24:54 2010
@@ -62,8 +62,6 @@
:test-find-item-by-revision))
-;;TODO: complete all test of the form test-add-<whatever>
-;; --> indirect call of add-to-version-history
;;TODO: test make-construct
;;TODO: test merge-constructs
@@ -157,10 +155,20 @@
(signals error (make-instance 'ItemIdentifierC))
(is-false (item-identifiers topic-1))
(add-item-identifier topic-1 ii-1)
+ (is (= (length (d::versions topic-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-1)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (item-identifiers topic-1)) 1))
(is (eql (first (item-identifiers topic-1)) ii-1))
(is (eql (identified-construct ii-1) topic-1))
(add-item-identifier topic-1 ii-2 :revision revision-2)
+ (is (= (length (d::versions topic-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (item-identifiers topic-1 :revision revision-0)) 2))
(is (= (length (item-identifiers topic-1 :revision revision-1)) 1))
(is (eql (first (item-identifiers topic-1 :revision revision-1)) ii-1))
@@ -180,6 +188,11 @@
:revision revision-2)))
2))
(delete-item-identifier topic-1 ii-2 :revision revision-3)
+ (is (= (length (d::versions topic-1)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is-false (item-identifiers topic-1 :revision revision-3))
(add-item-identifier topic-1 ii-1 :revision revision-4)
(is (= (length (union (list ii-1)
@@ -208,10 +221,20 @@
(signals error (make-instance 'PersistentIdC))
(is-false (psis topic-1))
(add-psi topic-1 psi-1)
+ (is (= (length (d::versions topic-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-1)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (psis topic-1)) 1))
(is (eql (first (psis topic-1)) psi-1))
(is (eql (identified-construct psi-1) topic-1))
(add-psi topic-1 psi-2 :revision revision-2)
+ (is (= (length (d::versions topic-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (psis topic-1 :revision revision-0)) 2))
(is (= (length (psis topic-1 :revision revision-1)) 1))
(is (eql (first (psis topic-1 :revision revision-1)) psi-1))
@@ -229,6 +252,11 @@
(psis topic-1 :revision revision-2)))
2))
(delete-psi topic-1 psi-2 :revision revision-3)
+ (is (= (length (d::versions topic-1)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is-false (psis topic-1 :revision revision-3))
(add-psi topic-1 psi-1 :revision revision-4)
(is (= (length (union (list psi-1)
@@ -257,10 +285,20 @@
(signals error (make-instance 'SubjectLocatorC))
(is-false (locators topic-1))
(add-locator topic-1 sl-1)
+ (is (= (length (d::versions topic-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-1)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (locators topic-1)) 1))
(is (eql (first (locators topic-1)) sl-1))
(is (eql (identified-construct sl-1) topic-1))
(add-locator topic-1 sl-2 :revision revision-2)
+ (is (= (length (d::versions topic-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (locators topic-1 :revision revision-0)) 2))
(is (= (length (locators topic-1 :revision revision-1)) 1))
(is (eql (first (locators topic-1 :revision revision-1)) sl-1))
@@ -271,6 +309,11 @@
(locators topic-1 :revision revision-0)))
2))
(delete-locator topic-1 sl-1 :revision revision-3)
+ (is (= (length (d::versions topic-1)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (union (list sl-2)
(locators topic-1 :revision revision-0)))
1))
@@ -311,10 +354,20 @@
:xtm-id "xtm-id-1"))
(is-false (topic-identifiers topic-1))
(add-topic-identifier topic-1 ti-1)
+ (is (= (length (d::versions topic-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-1)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (topic-identifiers topic-1)) 1))
(is (eql (first (topic-identifiers topic-1)) ti-1))
(is (eql (identified-construct ti-1) topic-1))
(add-topic-identifier topic-1 ti-2 :revision revision-2)
+ (is (= (length (d::versions topic-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (topic-identifiers topic-1 :revision revision-0)) 2))
(is (= (length (topic-identifiers topic-1 :revision revision-1)) 1))
(is (eql (first (topic-identifiers topic-1 :revision revision-1)) ti-1))
@@ -325,6 +378,11 @@
(topic-identifiers topic-1 :revision revision-0)))
2))
(delete-topic-identifier topic-1 ti-1 :revision revision-3)
+ (is (= (length (d::versions topic-1)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions topic-1)))
(is (= (length (union (list ti-2)
(topic-identifiers topic-1 :revision revision-0)))
1))
@@ -529,16 +587,31 @@
"Tests variuas functions of the ReifialeConstructC."
(with-fixture with-empty-db (*db-dir*)
(let ((reifier-top (make-instance 'TopicC))
- (reified-rc (make-instance 'd::ReifiableConstructC)))
+ (reified-rc (make-instance 'd::AssociationC))
+ (version-0-5 50)
+ (version-1 100)
+ (version-2 200)
+ (version-3 300))
(is-false (reifier reified-rc))
(is-false (reified-construct reifier-top))
- (add-reifier reified-rc reifier-top :revision 100)
+ (add-reifier reified-rc reifier-top :revision version-1)
+ (is (= (length (d::versions reified-rc)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) version-1)
+ (= (d::end-revision vi) 0)))
+ (d::versions reified-rc)))
(is (eql reifier-top (reifier reified-rc)))
(is (eql reified-rc (reified-construct reifier-top)))
- (is (eql reifier-top (reifier reified-rc :revision 200)))
- (is (eql reified-rc (reified-construct reifier-top :revision 200)))
- (is-false (reifier reified-rc :revision 50))
- (is-false (reified-construct reifier-top :revision 50)))))
+ (is (eql reifier-top (reifier reified-rc :revision version-2)))
+ (is (eql reified-rc (reified-construct reifier-top :revision version-2)))
+ (is-false (reifier reified-rc :revision version-0-5))
+ (is-false (reified-construct reifier-top :revision version-0-5))
+ (delete-reifier reified-rc reifier-top :revision version-3)
+ (is (= (length (d::versions reified-rc)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) version-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions reified-rc))))))
(test test-OccurrenceC ()
@@ -560,9 +633,19 @@
(is-false (parent occ-1))
(is-false (occurrences top-1))
(add-occurrence top-1 occ-1 :revision revision-1)
+ (is (= (length (d::versions top-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-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)
+ (is (= (length (d::versions top-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-1)))
(is (= (length (union (list occ-1 occ-2)
(occurrences top-1))) 2))
(is (= (length (union (list occ-1)
@@ -570,6 +653,11 @@
(add-occurrence top-1 occ-2 :revision revision-3)
(is (= (length (d::slot-p top-1 'd::occurrences)) 2))
(delete-occurrence top-1 occ-1 :revision revision-4)
+ (is (= (length (d::versions top-1)) 4))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-4)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-1)))
(is (= (length (union (list occ-2)
(occurrences top-1 :revision revision-4))) 1))
(is (= (length (union (list occ-2)
@@ -594,7 +682,17 @@
(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)
+ (is (= (length (d::versions top-2)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-7)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-2)))
(delete-parent occ-2 top-2 :revision revision-8)
+ (is (= (length (d::versions top-2)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-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))))))
@@ -678,9 +776,19 @@
(is-false (parent name-1))
(is-false (names top-1))
(add-name top-1 name-1 :revision revision-1)
+ (is (= (length (d::versions top-1)) 1))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-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)
+ (is (= (length (d::versions top-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-1)))
(is (= (length (union (list name-1 name-2)
(names top-1))) 2))
(is (= (length (union (list name-1)
@@ -688,6 +796,11 @@
(add-name top-1 name-2 :revision revision-3)
(is (= (length (d::slot-p top-1 'd::names)) 2))
(delete-name top-1 name-1 :revision revision-4)
+ (is (= (length (d::versions top-1)) 4))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-4)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-1)))
(is (= (length (union (list name-2)
(names top-1 :revision revision-4))) 1))
(is (= (length (union (list name-2)
@@ -712,7 +825,17 @@
(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)
+ (is (= (length (d::versions top-2)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-7)
+ (= (d::end-revision vi) 0)))
+ (d::versions top-2)))
(delete-parent name-2 top-2 :revision revision-8)
+ (is (= (length (d::versions top-2)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-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))))))
@@ -812,15 +935,26 @@
(assoc-2 (make-instance 'AssociationC))
(revision-1 100)
(revision-2 200)
- (revision-3 300))
+ (revision-3 300)
+ (revision-4 400))
(setf *TM-REVISION* revision-1)
(is-false (roles assoc-1))
(is-false (parent role-1))
(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)
+ (= (d::end-revision vi) 0)))
+ (d::versions assoc-1)))
(is (eql (parent role-1 :revision revision-1) assoc-1))
(is (= (length (union (list role-1)
(roles assoc-1))) 1))
(add-role assoc-1 role-2 :revision revision-2)
+ (is (= (length (d::versions assoc-1)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-2)
+ (= (d::end-revision vi) 0)))
+ (d::versions assoc-1)))
(is (= (length (union (list role-1 role-2)
(roles assoc-1))) 2))
(is (= (length (union (list role-1)
@@ -830,6 +964,11 @@
(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)
+ (is (= (length (d::versions assoc-1)) 3))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-3)
+ (= (d::end-revision vi) 0)))
+ (d::versions assoc-1)))
(is-false (parent role-1))
(is (= (length (union (list role-2)
(roles assoc-1))) 1))
@@ -850,7 +989,13 @@
(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)))))
+ (is (= (length (slot-value role-2 'parent)) 2))
+ (delete-parent role-1 assoc-2 :revision revision-4)
+ (is (= (length (d::versions assoc-2)) 2))
+ (is-true (find-if #'(lambda(vi)
+ (and (= (d::start-revision vi) revision-4)
+ (= (d::end-revision vi) 0)))
+ (d::versions assoc-2))))))
(test test-player ()
More information about the Isidorus-cvs
mailing list