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

Lukas Giessmann lgiessmann at common-lisp.net
Tue Mar 9 17:52:12 UTC 2010


Author: lgiessmann
Date: Tue Mar  9 12:52:12 2010
New Revision: 221

Log:
new-datamodel: fixed a bug in delete-construct (TopicC) and added some unit-tests for delete-construct (PersistentIdC, SubjectLocatorS, ItemIdentifierC)

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	Tue Mar  9 12:52:12 2010
@@ -870,7 +870,7 @@
   (let ((psis-to-delete
 	 (map 'list #'identifier (slot-p construct 'psis)))
 	(sls-to-delete
-	 (map 'list #'identifier (slot-p construct 'psis)))
+	 (map 'list #'identifier (slot-p construct 'locators)))
 	(names-to-delete
 	 (map 'list #'characteristic (slot-p construct 'names)))
 	(occurrences-to-delete (slot-p construct 'occurrences))

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	Tue Mar  9 12:52:12 2010
@@ -37,7 +37,9 @@
 	   :test-RoleC
 	   :test-player
 	   :test-TopicMapC
-	   :test-delete-ItemIdentifierC))
+	   :test-delete-ItemIdentifierC
+	   :test-delete-PersistentIdC
+	   :test-delete-SubjectLocatorC))
 
 
 ;;TODO: test delete-construct
@@ -924,8 +926,11 @@
     (let ((ii-1 (make-instance 'ItemIdentifierC :uri "ii-1"))
 	  (ii-2 (make-instance 'ItemIdentifierC :uri "ii-2"))
 	  (ii-3 (make-instance 'ItemIdentifierC :uri "ii-3"))
+	  (ii-4 (make-instance 'ItemIdentifierC :uri "ii-4"))
 	  (occ-1 (make-instance 'OccurrenceC))
+	  (occ-2 (make-instance 'OccurrenceC))
 	  (name-1 (make-instance 'NameC))
+	  (name-2 (make-instance 'NameC))
 	  (revision-1 100)
 	  (revision-2 200))
       (setf *TM-REVISION* 100)
@@ -935,16 +940,110 @@
       (add-item-identifier name-1 ii-1 :revision revision-2)
       (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC))
 	     3))
-      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3))
+      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 4))
       (delete-construct ii-3)
-      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 2))
+      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3))
       (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC))
 	     3))
       (delete-construct ii-1)
-      ;(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 1))
-      ;(is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC))
-	;     2))
-      )))
+      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 2))
+      (is (= (length (elephant:get-instances-by-class 'd::ItemIdAssociationC))
+	     1))
+      (delete-construct occ-1)
+      (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 1))
+      (is-false (elephant:get-instances-by-class 'd::ItemIdAssociationC))
+      (add-item-identifier occ-2 ii-4 :revision revision-1)
+      (delete-item-identifier occ-2 ii-4 :revision revision-2)
+      (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)))))
+
+
+(test test-delete-PersistentIdC ()
+  "Tests the function delete-construct of the class PersistentIdC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((psi-1 (make-instance 'PersistentIdC :uri "psi-1"))
+	  (psi-2 (make-instance 'PersistentIdC :uri "psi-2"))
+	  (psi-3 (make-instance 'PersistentIdC :uri "psi-3"))
+	  (psi-4 (make-instance 'PersistentIdC :uri "psi-4"))
+	  (topic-1 (make-instance 'TopicC))
+	  (topic-2 (make-instance 'TopicC))
+	  (topic-3 (make-instance 'TopicC))
+	  (topic-4 (make-instance 'TopicC))
+	  (revision-1 100)
+	  (revision-2 200))
+      (setf *TM-REVISION* 100)
+      (add-psi topic-1 psi-1 :revision revision-1)
+      (add-psi topic-1 psi-2 :revision revision-2)
+      (delete-psi topic-1 psi-1 :revision revision-2)
+      (add-psi topic-3 psi-1 :revision revision-2)
+      (is (= (length (elephant:get-instances-by-class 'd::PersistentIdAssociationC))
+	     3))
+      (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 4))
+      (delete-construct psi-3)
+      (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 3))
+      (is (= (length (elephant:get-instances-by-class 'd::PersistentIdAssociationC))
+	     3))
+      (delete-construct psi-1)
+      (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 2))
+      (is (= (length (elephant:get-instances-by-class 'd::PersistentIdAssociationC))
+	     1))
+      (delete-construct topic-1)
+      (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 1))
+      (is-false (elephant:get-instances-by-class 'd::PersistentIdAssociationC))
+      (add-psi topic-2 psi-4 :revision revision-1)
+      (delete-psi topic-2 psi-4 :revision revision-2)
+      (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)))))
+
+
+(test test-delete-SubjectLocatorC ()
+  "Tests the function delete-construct of the class SubjectLocatorC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((sl-1 (make-instance 'SubjectLocatorC :uri "sl-1"))
+	  (sl-2 (make-instance 'SubjectLocatorC :uri "sl-2"))
+	  (sl-3 (make-instance 'SubjectLocatorC :uri "sl-3"))
+	  (sl-4 (make-instance 'SubjectLocatorC :uri "sl-4"))
+	  (topic-1 (make-instance 'TopicC))
+	  (topic-2 (make-instance 'TopicC))
+	  (topic-3 (make-instance 'TopicC))
+	  (topic-4 (make-instance 'TopicC))
+	  (revision-1 100)
+	  (revision-2 200))
+      (setf *TM-REVISION* 100)
+      (add-locator topic-1 sl-1 :revision revision-1)
+      (add-locator topic-1 sl-2 :revision revision-2)
+      (delete-locator topic-1 sl-1 :revision revision-2)
+      (add-locator topic-3 sl-1 :revision revision-2)
+      (is (= (length (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC))
+	     3))
+      (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 4))
+      (delete-construct sl-3)
+      (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 3))
+      (is (= (length (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC))
+	     3))
+      (delete-construct sl-1)
+      (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
+      (is (= (length (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC))
+	     1))
+      (delete-construct topic-1)
+      (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1))
+      (is-false (elephant:get-instances-by-class 'd::SubjectLocatorAssociationC))
+      (add-locator topic-2 sl-4 :revision revision-1)
+      (delete-locator topic-2 sl-4 :revision revision-2)
+      (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)))))
       
 
 
@@ -970,4 +1069,6 @@
   (it.bese.fiveam:run! 'test-player)
   (it.bese.fiveam:run! 'test-TopicMapC)
   (it.bese.fiveam:run! 'test-delete-ItemIdentifierC)
+  (it.bese.fiveam:run! 'test-delete-PersistentIdC)
+  (it.bese.fiveam:run! 'test-delete-SubjectLocatorC)
   )
\ No newline at end of file




More information about the Isidorus-cvs mailing list