[isidorus-cvs] r214 - in branches/new-datamodel: docs src/model src/unit_tests

[Lukas Giessmann]

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