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

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Mar 22 14:49:05 2010
New Revision: 247

Log:
new-datamodel: added some unit-test for "make-construct" --> "VersionedConstructC" and unknown class; fixed a problem in "make-construct" that appears when creating "VersionedConstructC"s

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	Mon Mar 22 14:49:05 2010
@@ -2692,6 +2692,9 @@
    history accordingly. Returns the object in question. Methods use
    specific keyword arguments for their purpose."
   (declare (symbol class-symbol))
+  (when (and (VersionedConstructC-p class-symbol)
+	     (not (getf args :start-revision)))
+    (error "From make-construct(): start-revision must be set"))
   (let ((construct
 	 (cond
 	   ((PointerC-p class-symbol)
@@ -2707,7 +2710,8 @@
 	   ((AssociationC-p class-symbol)
 	    (apply #'make-association args))
 	   ((VersionedConstructC-p class-symbol)
-	    (apply #'make-instance (rec-remf args :start-revision)))
+	    (apply #'make-instance class-symbol
+		   (rec-remf args :start-revision)))
 	   (t
 	    (apply #'make-instance class-symbol args))))
 	(start-revision (getf args :start-revision)))
@@ -2718,8 +2722,6 @@
       (complete-scopable construct (getf args :themes)
 			 :start-revision start-revision))
     (when (typep construct 'VersionedConstructC)
-      (unless start-revision
-	(error "From make-construct(): start-revision must be set"))
       (add-to-version-history construct :start-revision start-revision))
     (if (typep construct 'ReifiableConstructC)
 	(complete-reifiable construct (getf args :item-identtifiers)

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 14:49:05 2010
@@ -59,7 +59,9 @@
 	   :test-equivalent-TopicC
 	   :test-equivalent-TopicMapC
 	   :test-class-p
-	   :test-find-item-by-revision))
+	   :test-find-item-by-revision
+	   :test-make-Unknown
+	   :test-make-VersionedConstructC))
 
 
 ;;TODO: test make-construct
@@ -1874,6 +1876,46 @@
 
 
 
+(test test-make-Unknown ()
+  "Tests the function make-construct corresponding to an unknown class."
+  (defclass Unknown ()
+    ((value :initarg :value
+	    :accessor value)))
+  (let ((construct (make-construct 'Unknown :value "value")))
+    (is-true construct)
+    (string= (value construct) "value")))
+
+
+(test test-make-VersionedConstructC ()
+  "Tests the function make-construct corresponding to VersionedConstructC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((psi-1 (make-instance 'PersistentIdC :uri "psi-1"))
+	  (top-1 (make-instance 'TopicC))
+	  (rev-0 0)
+	  (rev-1 100)
+	  (rev-2 200))
+      (let ((vc (make-construct 'VersionedConstructC
+				:start-revision rev-2))
+	    (psi-assoc (make-construct 'd::PersistentIdAssociationC
+				       :start-revision rev-1
+				       :identifier psi-1
+				       :parent-construct top-1)))
+	(signals error (make-construct 'd::PersistentIdAssociationC
+				       :start-revision rev-1
+				       :identifier psi-1))
+	(signals error (make-construct 'VersionedConstructC))
+	(is (= (length (d::versions vc)) 1))
+	(is-true (find-if #'(lambda(vi)
+			      (and (= (d::start-revision vi) rev-2)
+				   (= (d::end-revision vi) rev-0)))
+			  (d::versions vc)))
+	(is (= (length (d::versions psi-assoc)) 1))
+	(is-true (find-if #'(lambda(vi)
+			      (and (= (d::start-revision vi) rev-1)
+				   (= (d::end-revision vi) rev-0)))
+			  (d::versions psi-assoc)))))))
+
+
 
 
 (defun run-datamodel-tests()
@@ -1918,4 +1960,6 @@
   (it.bese.fiveam:run! 'test-equivalent-TopicMapC)
   (it.bese.fiveam:run! 'test-class-p)
   (it.bese.fiveam:run! 'test-find-item-by-revision)
+  (it.bese.fiveam:run! 'test-make-Unknown)
+  (it.bese.fiveam:run! 'test-make-VersionedConstructC)
   )
\ No newline at end of file