Author: lgiessmann Date: Fri Feb 26 15:22:11 2010 New Revision: 214 Log: new-datamodel: added some unit-tests for the base class ScopableC. Modified: branches/new-datamodel/docs/isidorus_data_model.pdf branches/new-datamodel/docs/isidorus_data_model.vsd branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/docs/isidorus_data_model.pdf ============================================================================== Binary files branches/new-datamodel/docs/isidorus_data_model.pdf (original) and branches/new-datamodel/docs/isidorus_data_model.pdf Fri Feb 26 15:22:11 2010 differ Modified: branches/new-datamodel/docs/isidorus_data_model.vsd ============================================================================== Binary files. No diff available. Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Fri Feb 26 15:22:11 2010 @@ -1711,8 +1711,7 @@ (:method ((construct ScopableC) (theme-topic TopicC) &key (revision *TM-REVISION*)) (let ((all-themes - (map 'list #'theme-topic - (remove-if #'marked-as-deleted-p (slot-p construct 'themes))))) + (map 'list #'theme-topic (slot-p construct 'themes)))) (if (find theme-topic all-themes) (let ((theme-assoc (loop for theme-assoc in (slot-p construct 'themes) @@ -1720,7 +1719,7 @@ return theme-assoc))) (add-to-version-history theme-assoc :start-revision revision)) (let ((assoc - (make-instance 'ScopeAssociationCn + (make-instance 'ScopeAssociationC :theme-topic theme-topic :scopable-construct construct))) (add-to-version-history assoc :start-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 Fri Feb 26 15:22:11 2010 @@ -31,7 +31,8 @@ :test-OccurrenceC :test-VariantC :test-NameC - :test-TypableC)) + :test-TypableC + :test-ScopableC)) ;;TODO: test delete-construct @@ -725,6 +726,56 @@ (is (= (length (union (list name-1 name-2) (used-as-type top-1))) 2)) (is (= (length (slot-value top-1 'd::used-as-type)) 2))))) + + +(test test-ScopableC () + "Tests various functions of the base class ScopableC." + (with-fixture with-empty-db (*db-dir*) + (let ((occ-1 (make-instance 'OccurrenceC)) + (occ-2 (make-instance 'OccurrenceC)) + (top-1 (make-instance 'TopicC)) + (top-2 (make-instance 'TopicC)) + (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)) + (add-theme occ-1 top-1) + (is (= (length (union (list top-1) + (themes occ-1))) 1)) + (is (= (length (union (list occ-1) + (used-as-theme top-1))) 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-2)) + (add-theme occ-1 top-1 :revision revision-3) + (is (= (length (union (list top-1) + (themes occ-1))) 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)) + (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)) + (add-theme occ-2 top-2 :revision revision-3) + (is (= (length (union (list top-1 top-2) + (themes occ-1))) 2)) + (is (= (length (union (list top-2) + (themes occ-2))) 1)) + (is (= (length (union (list occ-1) + (used-as-theme top-1))) 1)) + (is (= (length (union (list occ-1 occ-2) + (used-as-theme top-2))) 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)) + (is (= (length (slot-value top-2 'd::used-as-theme)) 2))))) @@ -744,4 +795,5 @@ (it.bese.fiveam:run! 'test-VariantC) (it.bese.fiveam:run! 'test-NameC) (it.bese.fiveam:run! 'test-TypableC) + (it.bese.fiveam:run! 'test-ScopableC) ) \ No newline at end of file