[isidorus-cvs] r248 - branches/new-datamodel/src/unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Mon Mar 22 21:58:32 UTC 2010


Author: lgiessmann
Date: Mon Mar 22 17:58:31 2010
New Revision: 248

Log:
new-datamodel: added unit-tests for "make-construct" related to "ItemIdentifierC", "PersistentIdC", "SubjectLocatorC" and "TopicIdentificationC"

Modified:
   branches/new-datamodel/src/unit_tests/datamodel_test.lisp

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	Mon Mar 22 17:58:31 2010
@@ -61,7 +61,11 @@
 	   :test-class-p
 	   :test-find-item-by-revision
 	   :test-make-Unknown
-	   :test-make-VersionedConstructC))
+	   :test-make-VersionedConstructC
+	   :test-make-TopicIdentificationC
+	   :test-make-PersistentIdC
+	   :test-make-SubjectLocatorC
+	   :test-make-ItemIdentifierC))
 
 
 ;;TODO: test make-construct
@@ -1916,6 +1920,134 @@
 			  (d::versions psi-assoc)))))))
 
 
+(test test-make-TopicIdentificationC ()
+  "Tests the function make-construct corresponding to TopicIdentificationC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-0 0)
+	  (rev-0-5 50)
+	  (rev-1 100)
+	  (top-1 (make-instance 'TopicC)))
+      (let ((tid-1 (make-construct 'TopicIdentificationC
+				   :uri "tid-1" :xtm-id "xtm-id-1"))
+	    (tid-2 (make-construct 'TopicIdentificationC
+				   :uri "tid-2" :xtm-id "xtm-id-2"
+				   :identified-construct top-1
+				   :start-revision rev-1)))
+	(is (string= (uri tid-1) "tid-1"))
+	(is (string= (xtm-id tid-1) "xtm-id-1"))
+	(is-false (d::slot-p tid-1 'd::identified-construct))
+	(is (string= (uri tid-2) "tid-2"))
+	(is (string= (xtm-id tid-2) "xtm-id-2"))
+	(is (= (length (d::slot-p tid-2 'd::identified-construct)) 1))
+	(is (= (length (d::versions
+			(first (d::slot-p tid-2 'd::identified-construct)))) 1))
+	(is (= (d::start-revision
+		(first (d::versions
+			(first (d::slot-p tid-2 'd::identified-construct)))))
+	       rev-1))
+	(is (= (d::end-revision
+		(first (d::versions
+			(first (d::slot-p tid-2 'd::identified-construct)))))
+	       rev-0))
+	(is (eql (identified-construct tid-2 :revision rev-1) top-1))
+	(is-false (identified-construct tid-2 :revision rev-0-5))
+	(is (eql (find-item-by-revision tid-2 rev-1 top-1) tid-2))))))
+
+
+(test test-make-PersistentIdC ()
+  "Tests the function make-construct corresponding to PersistentIdC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-0 0)
+	  (rev-0-5 50)
+	  (rev-1 100)
+	  (top-1 (make-instance 'TopicC)))
+      (let ((psi-1 (make-construct 'PersistentIdC :uri "psi-1"))
+	    (psi-2 (make-construct 'PersistentIdC
+				   :uri "psi-2"
+				   :identified-construct top-1
+				   :start-revision rev-1)))
+	(is (string= (uri psi-1) "psi-1"))
+	(is-false (d::slot-p psi-1 'd::identified-construct))
+	(is (string= (uri psi-2) "psi-2"))
+	(is (= (length (d::slot-p psi-2 'd::identified-construct)) 1))
+	(is (= (length (d::versions
+			(first (d::slot-p psi-2 'd::identified-construct)))) 1))
+	(is (= (d::start-revision
+		(first (d::versions
+			(first (d::slot-p psi-2 'd::identified-construct)))))
+	       rev-1))
+	(is (= (d::end-revision
+		(first (d::versions
+			(first (d::slot-p psi-2 'd::identified-construct)))))
+	       rev-0))
+	(is (eql (identified-construct psi-2 :revision rev-1) top-1))
+	(is-false (identified-construct psi-2 :revision rev-0-5))
+	(is (eql (find-item-by-revision psi-2 rev-1 top-1) psi-2))))))
+
+
+(test test-make-SubjectLocatorC ()
+  "Tests the function make-construct corresponding to SubjectLocatorC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-0 0)
+	  (rev-0-5 50)
+	  (rev-1 100)
+	  (top-1 (make-instance 'TopicC)))
+      (let ((sl-1 (make-construct 'SubjectLocatorC :uri "sl-1"))
+	    (sl-2 (make-construct 'SubjectLocatorC
+				  :uri "sl-2"
+				  :identified-construct top-1
+				  :start-revision rev-1)))
+	(is (string= (uri sl-1) "sl-1"))
+	(is-false (d::slot-p sl-1 'd::identified-construct))
+	(is (string= (uri sl-2) "sl-2"))
+	(is (= (length (d::slot-p sl-2 'd::identified-construct)) 1))
+	(is (= (length (d::versions
+			(first (d::slot-p sl-2 'd::identified-construct)))) 1))
+	(is (= (d::start-revision
+		(first (d::versions
+			(first (d::slot-p sl-2 'd::identified-construct)))))
+	       rev-1))
+	(is (= (d::end-revision
+		(first (d::versions
+			(first (d::slot-p sl-2 'd::identified-construct)))))
+	       rev-0))
+	(is (eql (identified-construct sl-2 :revision rev-1) top-1))
+	(is-false (identified-construct sl-2 :revision rev-0-5))
+	(is (eql (find-item-by-revision sl-2 rev-1 top-1) sl-2))))))
+
+
+(test test-make-ItemIdentifierC ()
+  "Tests the function make-construct corresponding to ItemIdentifierC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-0 0)
+	  (rev-0-5 50)
+	  (rev-1 100)
+	  (top-1 (make-instance 'AssociationC)))
+      (let ((ii-1 (make-construct 'ItemIdentifierC :uri "ii-1"))
+	    (ii-2 (make-construct 'ItemIdentifierC
+				  :uri "ii-2"
+				  :identified-construct top-1
+				  :start-revision rev-1)))
+	(is (string= (uri ii-1) "ii-1"))
+	(is-false (d::slot-p ii-1 'd::identified-construct))
+	(is (string= (uri ii-2) "ii-2"))
+	(is (= (length (d::slot-p ii-2 'd::identified-construct)) 1))
+	(is (= (length (d::versions
+			(first (d::slot-p ii-2 'd::identified-construct)))) 1))
+	(is (= (d::start-revision
+		(first (d::versions
+			(first (d::slot-p ii-2 'd::identified-construct)))))
+	       rev-1))
+	(is (= (d::end-revision
+		(first (d::versions
+			(first (d::slot-p ii-2 'd::identified-construct)))))
+	       rev-0))
+	(is (eql (identified-construct ii-2 :revision rev-1) top-1))
+	(is-false (identified-construct ii-2 :revision rev-0-5))
+	(is (eql (find-item-by-revision ii-2 rev-1 top-1) ii-2))))))
+	
+
+
 
 
 (defun run-datamodel-tests()
@@ -1962,4 +2094,8 @@
   (it.bese.fiveam:run! 'test-find-item-by-revision)
   (it.bese.fiveam:run! 'test-make-Unknown)
   (it.bese.fiveam:run! 'test-make-VersionedConstructC)
+  (it.bese.fiveam:run! 'test-make-TopicIdentificationC)
+  (it.bese.fiveam:run! 'test-make-PersistentIdC)
+  (it.bese.fiveam:run! 'test-make-SubjectLocatorC)
+  (it.bese.fiveam:run! 'test-make-ItemIdentifierC)
   )
\ No newline at end of file




More information about the Isidorus-cvs mailing list