Author: lgiessmann Date: Thu Feb 25 16:36:10 2010 New Revision: 209
Log: new-datamodel: added some unit-tests for add-occurrence, delete-occurrence, occurrences; fixed some bugs in these funtions
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 Thu Feb 25 16:36:10 2010 @@ -486,7 +486,7 @@ :accessor characteristic :inherit t :initform (error "From CharacteristicCAssociation(): characteristic must be set") - :associate CharactersiticC + :associate CharacteristicC :documentation "Associates this object with the actual characteristic object.")) (:documentation "An abstract base class for all association-objects that @@ -986,7 +986,7 @@ with the passed construct and the passed version.") (:method ((construct TopicC) &key (revision 0)) (let ((assocs (filter-slot-value-by-revision - construct 'occurences :start-revision revision))) + construct 'occurrences :start-revision revision))) (map 'list #'characteristic assocs))))
@@ -998,7 +998,8 @@ an error is thrown.") (:method ((construct TopicC) (occurrence OccurrenceC) &key (revision *TM-REVISION*)) - (when (not (eql (parent occurrence) construct)) + (when (and (parent occurrence) + (not (eql (parent occurrence) 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))) (let ((all-occurrences @@ -1007,7 +1008,7 @@ (slot-p construct 'occurrences))))) (if (find occurrence all-occurrences) (let ((occ-assoc (loop for occ-assoc in (slot-p construct 'occurrences) - when (eql (parent-construct occ-assoc) occurrence) + when (eql (parent-construct occ-assoc) construct) return occ-assoc))) (add-to-version-history occ-assoc :start-revision revision)) (let ((assoc @@ -1024,7 +1025,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) occurrence) + when (eql (parent-construct occ-assoc) construct) return occ-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision 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 Thu Feb 25 16:36:10 2010 @@ -27,14 +27,13 @@ :test-get-item-by-item-identifier :test-get-item-by-locator :test-get-item-by-psi - :test-ReifiableConstructC)) + :test-ReifiableConstructC + :test-OccurrenceC))
;;TODO: test delete-construct -;;TODO: test merge-constructs when merging was caused by an item-dentifier -;;TODO: test merge-constructs when merging was caused by an psi -;;TODO: test merge-constructs when merging was caused by an subject-locator -;;TODO: test merge-constructs when merging was caused by a topic-id +;;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 ;; (occurrences, names, variants, associations, roles) ;;TODO: test ReifiableConstructC --> reifier has to be merged @@ -513,6 +512,41 @@ (is-false (reified-construct reifier-top :revision 50)))))
+(test test-OccurrenceC () + "Tests various functions of OccurrenceC." + (with-fixture with-empty-db (*db-dir*) + (let ((occ-1 (make-instance 'OccurrenceC)) + (occ-2 (make-instance 'OccurrenceC)) + (top (make-instance 'TopicC)) + (revision-1 100) + (revision-2 200) + (revision-3 300) + (revision-4 400)) + (setf *TM-REVISION* revision-1) + (is-false (parent occ-1)) + (is-false (occurrences top)) + (add-occurrence top occ-1 :revision revision-1) + (is (= (length (union (list occ-1) + (occurrences top))) 1)) + (add-occurrence top occ-2 :revision revision-2) + (is (= (length (union (list occ-1 occ-2) + (occurrences top))) 2)) + (is (= (length (union (list occ-1) + (occurrences top :revision revision-1))) 1)) + (add-occurrence top occ-2 :revision revision-3) + (is (= (length (d::slot-p top 'd::occurrences)) 2)) + (delete-occurrence top occ-1 :revision revision-4) + (is (= (length (union (list occ-2) + (occurrences top :revision revision-4))) 1)) + (is (= (length (union (list occ-2) + (occurrences top))) 1)) + (is (= (length (union (list occ-1 occ-2) + (occurrences top :revision revision-2))) 2)) + (add-occurrence top occ-1 :revision revision-4) + (is (= (length (union (list occ-2 occ-1) + (occurrences top))) 2))))) + + (defun run-datamodel-tests() (it.bese.fiveam:run! 'test-VersionInfoC) (it.bese.fiveam:run! 'test-VersionedConstructC) @@ -525,4 +559,5 @@ (it.bese.fiveam:run! 'test-get-item-by-locator) (it.bese.fiveam:run! 'test-get-item-by-psi) (it.bese.fiveam:run! 'test-ReifiableConstructC) + (it.bese.fiveam:run! 'test-OccurrenceC) ) \ No newline at end of file