Author: lgiessmann Date: Wed Mar 10 08:59:47 2010 New Revision: 222 Log: new-datamodel: fixed a bug in "delete-construct"; finalized the unit-tests for "delete-construct" 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 Wed Mar 10 08:59:47 2010 @@ -597,18 +597,7 @@ (defmethod delete-construct :after ((construct elephant:persistent)) - "Removes the passed object from the data base when it is not - referenced by a parent TM construct. - So pointers, characteristics, topics, roles and associations - can be only dropped when there are not owned by a parent." - (if (or (typep construct 'PointerC) - (typep construct 'CharacteristicC) - (typep construct 'TopicC) - (typep construct 'RoleC) - (typep construct 'AssociationC)) - (unless (owned-p construct) - (drop-instance construct)) - (drop-instance construct))) + (drop-instance construct)) (defun filter-slot-value-by-revision (construct slot-symbol @@ -835,7 +824,7 @@ ;;; CharacteristicAssociationC (defmethod delete-construct :before ((construct CharacteristicAssociationC)) - (delete-1-n-association construct 'charactersitic)) + (delete-1-n-association construct 'characteristic)) ;;; OccurrenceAssociationC @@ -867,30 +856,40 @@ ;;; TopicC (defmethod delete-construct :before ((construct TopicC)) - (let ((psis-to-delete - (map 'list #'identifier (slot-p construct 'psis))) - (sls-to-delete - (map 'list #'identifier (slot-p construct 'locators))) - (names-to-delete - (map 'list #'characteristic (slot-p construct 'names))) - (occurrences-to-delete (slot-p construct 'occurrences)) - (roles-to-delete - (map 'list #'parent-construct (slot-p construct 'player-in-roles))) - (typables-to-delete - (map 'list #'typable-construct (slot-p construct 'used-as-type))) + (let ((psi-assocs-to-delete (slot-p construct 'psis)) + (sl-assocs-to-delete (slot-p construct 'locators)) + (name-assocs-to-delete (slot-p construct 'names)) + (occ-assocs-to-delete (slot-p construct 'occurrences)) + (role-assocs-to-delete (slot-p construct 'player-in-roles)) + (type-assocs-to-delete (slot-p construct 'used-as-type)) + (scope-assocs-to-delete (slot-p construct 'used-as-theme)) (reifier-assocs-to-delete (slot-p construct 'reified-construct))) - (dolist (construct-to-delete (append psis-to-delete - sls-to-delete - names-to-delete - occurrences-to-delete - roles-to-delete - typables-to-delete - reifier-assocs-to-delete)) - (delete-construct construct-to-delete))) - (dolist (scope-assoc-to-delete (slot-p construct 'used-as-theme)) - (delete-construct scope-assoc-to-delete)) - (dolist (tm (slot-p construct 'in-topicmaps)) - (remove-association construct 'in-topicmaps tm))) + (let ((all-psis (map 'list #'identifier psi-assocs-to-delete)) + (all-sls (map 'list #'identifier sl-assocs-to-delete)) + (all-names (map 'list #'characteristic name-assocs-to-delete)) + (all-occs (map 'list #'characteristic occ-assocs-to-delete)) + (all-roles (map 'list #'parent-construct role-assocs-to-delete)) + (all-types (map 'list #'typable-construct type-assocs-to-delete))) + (dolist (construct-to-delete (append psi-assocs-to-delete + sl-assocs-to-delete + name-assocs-to-delete + occ-assocs-to-delete + role-assocs-to-delete + type-assocs-to-delete + scope-assocs-to-delete + reifier-assocs-to-delete)) + (delete-construct construct-to-delete)) + (dolist (candidate-to-delete (append all-psis all-sls all-names all-occs)) + (unless (owned-p candidate-to-delete) + (delete-construct candidate-to-delete))) + (dolist (candidate-to-delete all-roles) + (unless (player-p candidate-to-delete) + (delete-construct candidate-to-delete))) + (dolist (candidate-to-delete all-types) + (unless (instance-of-p candidate-to-delete) + (delete-construct candidate-to-delete))) + (dolist (tm (slot-p construct 'in-topicmaps)) + (remove-association construct 'in-topicmaps tm))))) (defmethod owned-p ((construct TopicC)) @@ -1101,7 +1100,7 @@ (:method ((construct TopicC) (name NameC) &key (revision (error "From delete-name(): revision must be set"))) (let ((assoc-to-delete (loop for name-assoc in (slot-p construct 'names) - when (eql (parent-construct name-assoc) construct) + when (eql (characteristic name-assoc) name) return name-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) @@ -1150,7 +1149,7 @@ (:method ((construct TopicC) (occurrence OccurrenceC) &key (revision (error "From delete-occurrence(): revision must be set"))) (let ((assoc-to-delete (loop for occ-assoc in (slot-p construct 'occurrences) - when (eql (parent-construct occ-assoc) construct) + when (eql (characteristic occ-assoc) occurrence) return occ-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) @@ -1301,10 +1300,13 @@ ;;; NameC (defmethod delete-construct :before ((construct NameC)) - (dolist (variant-to-delete - (map 'list #'characteristic - (slot-p construct 'variants))) - (delete-construct variant-to-delete))) + (let ((variant-assocs-to-delete (slot-p construct 'variants))) + (let ((all-variants (map 'list #'characteristic variant-assocs-to-delete))) + (dolist (variant-assoc-to-delete variant-assocs-to-delete) + (delete-construct variant-assoc-to-delete)) + (dolist (candidate-to-delete all-variants) + (unless (owned-p candidate-to-delete) + (delete-construct candidate-to-delete)))))) (defgeneric variants (construct &key revision) @@ -1432,11 +1434,15 @@ ;;; AssociationC (defmethod delete-construct :before ((construct AssociationC)) - (dolist (role-to-delete - (map 'list #'role (slot-p construct 'roles))) - (delete-construct role-to-delete)) - (dolist (tm (slot-p construct 'in-topicmaps)) - (remove-association construct 'in-topicmaps tm))) + (let ((roles-assocs-to-delete (slot-p construct 'roles))) + (let ((all-roles (map 'list #'role roles-assocs-to-delete))) + (dolist (role-assoc-to-delete roles-assocs-to-delete) + (delete-construct role-assoc-to-delete)) + (dolist (candidate-to-delete all-roles) + (unless (owned-p candidate-to-delete) + (delete-construct candidate-to-delete))) + (dolist (tm (slot-p construct 'in-topicmaps)) + (remove-association construct 'in-topicmaps tm))))) (defmethod owned-p ((construct AssociationC)) @@ -1499,6 +1505,14 @@ (delete-construct player-assoc-to-delete))) +(defgeneric player-p (construct) + (:documentation "Returns t if a player is set in this role. + t is also returned if the player is markes-as-deleted.") + (:method ((construct RoleC)) + (when (slot-p construct 'player) + t))) + + (defmethod owned-p ((construct RoleC)) (when (slot-p construct 'parent) t)) @@ -1573,7 +1587,7 @@ return player-assoc))) (when (and already-set-player (not (eql already-set-player player-topic))) - (error "From add-player(): ~a can't be palyed by ~a since it is played by ~a" + (error "From add-player(): ~a can't be played by ~a since it is played by ~a" construct player-topic already-set-player)) (cond (already-set-player (let ((player-assoc @@ -1598,7 +1612,7 @@ &key (revision (error "From delete-parent(): revision must be set"))) (let ((assoc-to-delete (loop for player-assoc in (slot-p construct 'player) - when (eql (player-topic player-assoc) player-topic) + when (eql (parent-construct player-assoc) construct) return player-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) @@ -1607,12 +1621,15 @@ ;;; ReifiableConstructC (defmethod delete-construct :before ((construct ReifiableConstructC)) - (let ((iis-to-delete - (map 'list #'identifier (slot-p construct 'item-identifiers))) - (reifier-tops-to-delete - (map 'list #'reifier-topic (slot-p construct 'reifier)))) - (dolist (construct-to-delete (append iis-to-delete reifier-tops-to-delete)) - (delete-construct construct-to-delete)))) + (let ((ii-assocs-to-delete (slot-p construct 'item-identifiers)) + (reifier-assocs-to-delete (slot-p construct 'reifier))) + (let ((all-iis (map 'list #'identifier ii-assocs-to-delete))) + (dolist (construct-to-delete (append ii-assocs-to-delete + reifier-assocs-to-delete)) + (delete-construct construct-to-delete)) + (dolist (ii all-iis) + (unless (owned-p ii) + (delete-construct ii)))))) (defgeneric item-identifiers (construct &key revision) @@ -1784,6 +1801,15 @@ (dolist (type-assoc-to-delete (slot-p construct 'instance-of)) (delete-construct type-assoc-to-delete))) + +(defgeneric instance-of-p (construct) + (:documentation "Returns t if there is any type set in this object. + t is also returned if the type is marked-as-deleted.") + (:method ((construct TypableC)) + (when (slot-p construct 'instance-of) + t))) + + (defgeneric instance-of (construct &key revision) (:documentation "Returns the type topic that is set on the passed revision.") 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 Wed Mar 10 08:59:47 2010 @@ -39,10 +39,17 @@ :test-TopicMapC :test-delete-ItemIdentifierC :test-delete-PersistentIdC - :test-delete-SubjectLocatorC)) + :test-delete-SubjectLocatorC + :test-delete-ReifiableConstructC + :test-delete-VariantC + :test-delete-NameC + :test-delete-OccurrenceC + :test-delete-TypableC + :test-delete-ScopableC + :test-delete-AssociationC + :test-delete-RoleC)) -;;TODO: test delete-construct ;;TODO: test merge-constructs when merging was caused by an item-dentifier, ;; a psi, a subject-locator, a topic-id ;;TODO: test merge-constructs when merging was caused by reifiers @@ -957,9 +964,15 @@ (add-item-identifier name-2 ii-4 :revision revision-2) (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC)) 2)) - (delete-construct ii-4) - (is-false (elephant:get-instances-by-class 'ItemIdentifierC)) - (is-false (elephant:get-instances-by-class 'd::ItemIdAssociationC))))) + (delete-construct occ-2) + (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 1)) + (is (= (length (union (list ii-4) (item-identifiers name-2))) 1)) + (delete-construct name-2) + (is-false (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + (is-false (elephant:get-instances-by-class 'ItemIdentifierC))))) + (test test-delete-PersistentIdC () @@ -999,9 +1012,12 @@ (add-psi topic-4 psi-4 :revision revision-2) (is (= (length (elephant:get-instances-by-class 'd::PersistentIdAssociationC)) 2)) - (delete-construct psi-4) - (is-false (elephant:get-instances-by-class 'PersistentIdC)) - (is-false (elephant:get-instances-by-class 'd::PersistentIdAssociationC))))) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 1)) + (delete-construct topic-2) + (is (= (length (elephant:get-instances-by-class 'd::PersistentIdAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 1)) + (is (= (length (union (list psi-4) (psis topic-4))) 1))))) (test test-delete-SubjectLocatorC () @@ -1041,10 +1057,284 @@ (add-locator topic-4 sl-4 :revision revision-2) (is (= (length (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC)) 2)) - (delete-construct sl-4) - (is-false (elephant:get-instances-by-class 'SubjectLocatorC)) - (is-false (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC))))) - + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1)) + (delete-construct topic-2) + (is (= (length (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1)) + (is (= (length (union (list sl-4) (locators topic-4))) 1))))) + + + +(test test-delete-ReifiableConstructC () + "Tests the function delete-construct of the class ReifiableConstructC" + (with-fixture with-empty-db (*db-dir*) + (let ((rc-1 (make-instance 'd::ReifiableConstructC)) + (rc-2 (make-instance 'd::ReifiableConstructC)) + (reifier-1 (make-instance 'TopicC)) + (reifier-2 (make-instance 'TopicC)) + (ii-1 (make-instance 'ItemIdentifierC :uri "ii-1")) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-reifier rc-1 reifier-1) + (add-item-identifier rc-1 ii-1) + (is (= (length (elephant:get-instances-by-class 'd::ReifiableConstructC)) + 2)) + (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'd::ReifierAssociationC)) + 1)) + (delete-reifier rc-1 reifier-1 :revision revision-2) + (delete-item-identifier rc-1 ii-1 :revision revision-2) + (add-reifier rc-2 reifier-1 :revision revision-2) + (add-item-identifier rc-2 ii-1 :revision revision-2) + (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + 2)) + (is (= (length (elephant:get-instances-by-class 'd::ReifierAssociationC)) + 2)) + (delete-construct rc-1) + (is (= (length (elephant:get-instances-by-class 'd::ReifiableConstructC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + 1)) + (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))) + (delete-construct ii-1) + (delete-construct reifier-1) + (is (= (length (elephant:get-instances-by-class 'd::ReifiableConstructC)) + 1)) + (is-false (elephant:get-instances-by-class 'd::ItemIdAssociationC)) + (is-false (elephant:get-instances-by-class 'd::ReifierAssociationC)) + (delete-construct reifier-2) + (is-false (elephant:get-instances-by-class 'd::ReifierAssociationC))))) + + +(test test-delete-VariantC () + "Tests the function delete-construct of the class VariantC" + (with-fixture with-empty-db (*db-dir*) + (let ((name-1 (make-instance 'NameC)) + (name-2 (make-instance 'NameC)) + (variant-1 (make-instance 'VariantC)) + (variant-2 (make-instance 'VariantC)) + (variant-3 (make-instance 'VariantC)) + (variant-4 (make-instance 'VariantC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-variant name-1 variant-1) + (add-variant name-1 variant-2) + (add-variant name-1 variant-3) + (delete-variant name-1 variant-1 :revision revision-2) + (delete-variant name-1 variant-2 :revision revision-2) + (add-variant name-2 variant-1 :revision revision-2) + (add-variant name-2 variant-2 :revision revision-2) + (is (= (length (elephant:get-instances-by-class 'd::VariantAssociationC)) + 5)) + (delete-construct variant-1) + (is (= (length (elephant:get-instances-by-class 'd::VariantAssociationC)) + 3)) + (is (= (length (elephant:get-instances-by-class 'VariantC)) 3)) + (delete-construct name-1) + (is (= (length (elephant:get-instances-by-class 'd::VariantAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'VariantC)) 2)) + (delete-construct name-2) + (is (= (length (elephant:get-instances-by-class 'VariantC)) 1)) + (is-false (elephant:get-instances-by-class 'd::VariantAssociationC)) + (delete-construct variant-4) + (is-false (elephant:get-instances-by-class 'VariantC))))) + + +(test test-delete-NameC () + "Tests the function delete-construct of the class NameC" + (with-fixture with-empty-db (*db-dir*) + (let ((topic-1 (make-instance 'TopicC)) + (topic-2 (make-instance 'TopicC)) + (name-1 (make-instance 'NameC)) + (name-2 (make-instance 'NameC)) + (name-3 (make-instance 'NameC)) + (name-4 (make-instance 'NameC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-name topic-1 name-1) + (add-name topic-1 name-2) + (add-name topic-1 name-3) + (delete-name topic-1 name-1 :revision revision-2) + (delete-name topic-1 name-2 :revision revision-2) + (add-name topic-2 name-1 :revision revision-2) + (add-name topic-2 name-2 :revision revision-2) + (is (= (length (elephant:get-instances-by-class 'd::NameAssociationC)) + 5)) + (delete-construct name-1) + (is (= (length (elephant:get-instances-by-class 'd::NameAssociationC)) + 3)) + (is (= (length (elephant:get-instances-by-class 'NameC)) 3)) + (delete-construct topic-1) + (is (= (length (elephant:get-instances-by-class 'd::NameAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'NameC)) 2)) + (delete-construct topic-2) + (is (= (length (elephant:get-instances-by-class 'NameC)) 1)) + (is-false (elephant:get-instances-by-class 'd::NameAssociationC)) + (delete-construct name-4) + (is-false (elephant:get-instances-by-class 'NameC))))) + + +(test test-delete-OccurrenceC () + "Tests the function delete-construct of the class OccurrenceC" + (with-fixture with-empty-db (*db-dir*) + (let ((topic-1 (make-instance 'TopicC)) + (topic-2 (make-instance 'TopicC)) + (occurrence-1 (make-instance 'OccurrenceC)) + (occurrence-2 (make-instance 'OccurrenceC)) + (occurrence-3 (make-instance 'OccurrenceC)) + (occurrence-4 (make-instance 'OccurrenceC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-occurrence topic-1 occurrence-1) + (add-occurrence topic-1 occurrence-2) + (add-occurrence topic-1 occurrence-3) + (delete-occurrence topic-1 occurrence-1 :revision revision-2) + (delete-occurrence topic-1 occurrence-2 :revision revision-2) + (add-occurrence topic-2 occurrence-1 :revision revision-2) + (add-occurrence topic-2 occurrence-2 :revision revision-2) + (is (= (length (elephant:get-instances-by-class + 'd::OccurrenceAssociationC)) 5)) + (delete-construct occurrence-1) + (is (= (length (elephant:get-instances-by-class + 'd::OccurrenceAssociationC)) 3)) + (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 3)) + (delete-construct topic-1) + (is (= (length (elephant:get-instances-by-class + 'd::OccurrenceAssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 2)) + (delete-construct topic-2) + (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 1)) + (is-false (elephant:get-instances-by-class 'd::OccurrenceAssociationC)) + (delete-construct occurrence-4) + (is-false (elephant:get-instances-by-class 'OccurrenceC))))) + + +(test test-delete-TypableC () + "Tests the function delete-construct of the class TypableC" + (with-fixture with-empty-db (*db-dir*) + (let ((name-1 (make-instance 'NameC)) + (name-2 (make-instance 'NameC)) + (type-1 (make-instance 'TopicC)) + (type-2 (make-instance 'TopicC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-type name-1 type-1) + (delete-type name-1 type-1 :revision revision-2) + (add-type name-1 type-2 :revision revision-2) + (add-type name-2 type-2) + (is (= (length (elephant:get-instances-by-class 'd::TypeAssociationC)) 3)) + (is (= (length (elephant:get-instances-by-class 'd::NameC)) 2)) + (delete-construct type-2) + (is (= (length (elephant:get-instances-by-class 'd::TypeAssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'd::NameC)) 1)) + (delete-construct name-1) + (is-false (elephant:get-instances-by-class 'd::TypeAssociationC)) + (is-false (elephant:get-instances-by-class 'd::NameC))))) + + +(test test-delete-ScopableC () + "Tests the function delete-construct of the class ScopableC" + (with-fixture with-empty-db (*db-dir*) + (let ((assoc-1 (make-instance 'AssociationC)) + (assoc-2 (make-instance 'AssociationC)) + (assoc-3 (make-instance 'AssociationC)) + (scope-1 (make-instance 'TopicC)) + (scope-2 (make-instance 'TopicC)) + (scope-3 (make-instance 'TopicC)) + (revision-1 100)) + (setf *TM-REVISION* revision-1) + (add-theme assoc-1 scope-1) + (add-theme assoc-1 scope-2) + (add-theme assoc-2 scope-1) + (is (= (length (elephant:get-instances-by-class 'd::ScopeAssociationC)) + 3)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 3)) + (delete-construct scope-1) + (is (= (length (elephant:get-instances-by-class 'd::ScopeAssociationC)) + 1)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 3)) + (delete-construct assoc-1) + (is-false (elephant:get-instances-by-class 'd::ScopeAssociationC)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 2)) + (add-theme assoc-2 scope-3) + (add-theme assoc-3 scope-3) + (is (= (length (elephant:get-instances-by-class 'd::ScopeAssociationC)) + 2)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 2)) + (delete-construct assoc-2) + (is (= (length (union (list scope-3) (themes assoc-3))) 1))))) + + +(test test-delete-AssociationC () + "Tests the function delete-construct of the class AssociationC" + (with-fixture with-empty-db (*db-dir*) + (let ((role-1 (make-instance 'RoleC)) + (role-2 (make-instance 'RoleC)) + (assoc-1 (make-instance 'AssociationC)) + (assoc-2 (make-instance 'AssociationC)) + (assoc-3 (make-instance 'AssociationC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-role assoc-1 role-1) + (delete-role assoc-1 role-1 :revision revision-2) + (add-role assoc-2 role-1 :revision revision-2) + (add-role assoc-2 role-2) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 3)) + (is (= (length (elephant:get-instances-by-class 'd::RoleAssociationC)) 3)) + (delete-construct role-1) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 1)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 3)) + (is (= (length (elephant:get-instances-by-class 'd::RoleAssociationC)) 1)) + (delete-role assoc-2 role-2 :revision revision-2) + (add-role assoc-3 role-2 :revision revision-2) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 1)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 3)) + (is (= (length (elephant:get-instances-by-class 'd::RoleAssociationC)) 2)) + (delete-construct assoc-3) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 1)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 2)) + (is (= (length (elephant:get-instances-by-class 'd::RoleAssociationC)) + 1))))) + + +(test test-delete-RoleC () + "Tests the function delete-construct of the class RoleC" + (with-fixture with-empty-db (*db-dir*) + (let ((role-1 (make-instance 'RoleC)) + (role-2 (make-instance 'RoleC)) + (player-1 (make-instance 'TopicC)) + (player-2 (make-instance 'TopicC)) + (revision-1 100) + (revision-2 200)) + (setf *TM-REVISION* revision-1) + (add-player role-1 player-1) + (delete-player role-1 player-1 :revision revision-2) + (add-player role-1 player-2 :revision revision-2) + (add-player role-2 player-1) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (elephant:get-instances-by-class 'd::PlayerAssociationC)) + 3)) + (delete-construct player-1) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 1)) + (is (= (length (elephant:get-instances-by-class 'd::PlayerAssociationC)) + 1)) + (delete-construct role-1) + (is-false (elephant:get-instances-by-class 'RoleC)) + (is-false (elephant:get-instances-by-class 'd::PlayerAssociationC))))) (defun run-datamodel-tests() @@ -1071,4 +1361,12 @@ (it.bese.fiveam:run! 'test-delete-ItemIdentifierC) (it.bese.fiveam:run! 'test-delete-PersistentIdC) (it.bese.fiveam:run! 'test-delete-SubjectLocatorC) + (it.bese.fiveam:run! 'test-delete-ReifiableConstructC) + (it.bese.fiveam:run! 'test-delete-VariantC) + (it.bese.fiveam:run! 'test-delete-NameC) + (it.bese.fiveam:run! 'test-delete-OccurrenceC) + (it.bese.fiveam:run! 'test-delete-TypableC) + (it.bese.fiveam:run! 'test-delete-ScopableC) + (it.bese.fiveam:run! 'test-delete-AssociationC) + (it.bese.fiveam:run! 'test-delete-RoleC) ) \ No newline at end of file