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

[Lukas Giessmann]

Author: lgiessmann
Date: Sun Mar 14 16:28:40 2010
New Revision: 226

Log:
new-datamodel: added some unit-tests for equivalent-construct depending on PointerC

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	Sun Mar 14 16:28:40 2010
@@ -1362,9 +1362,10 @@
 	   (integer start-revision)
 	   (type (or null TopicC) instance-of reifier))
   (or (and (string= (charvalue construct) charvalue)
-	   (not (set-exclusive-or (themes construct :revision start-revision)
-				  themes))
-	   (eql instance-of (instance-of construct :revision start-revision)))
+	   (equivalent-scopable-construct construct themes
+					  :start-revision start-revision)
+	   (equivalent-typable-construct construct instance-of
+					 :start-revision start-revision))
       (equivalent-reifiable-construct construct reifier item-identifiers
 				      :start-revision start-revision)))
 
@@ -1542,9 +1543,10 @@
   (or
    (and
     (not (set-exclusive-or roles (roles construct :revision start-revision)))
-    (eql instance-of (instance-of construct :revision start-revision))
-    (not (set-exclusive-or themes
-			   (themes construct :revision start-revision))))
+    (equivalent-typable-construct construct instance-of
+				  :start-revision start-revision)
+    (equivalent-scopable-construct construct themes
+				   :start-revision start-revision))
    (equivalent-reifiable-construct construct reifier item-identifiers
 				   :start-revision start-revision)))
 
@@ -1621,7 +1623,8 @@
   (declare (integer start-revision)
 	   (type (or null TopicC) player instance-of reifier)
 	   (list item-identifiers))
-  (or (and (eql instance-of (instance-of construct :revision start-revision))
+  (or (and (equivalent-typable-construct construct instance-of
+					 :start-revision start-revision)
 	   (eql player (player construct :revision start-revision)))
       (equivalent-reifiable-construct construct reifier item-identifiers
 				      :start-revision start-revision)))
@@ -1886,8 +1889,25 @@
 	(mark-as-deleted assoc-to-delete :revision revision))
       construct)))
 
+;;; TypableC
+(defgeneric equivalent-typable-construct (construct instance-of
+						     &key start-revision)
+  (:documentation "Returns t if the passed constructs are TMDM equal.")
+  (:method ((construct TypableC) instance-of &key (start-revision 0))
+    (declare (integer start-revision)
+	     (type (or null TopicC) instance-of))
+    (eql (instance-of construct :revision start-revision) instance-of)))
+
 
 ;;; ScopableC
+(defgeneric equivalent-scopable-construct (construct themes &key start-revision)
+  (:documentation "Returns t if the passed constructs are TMDM equal.")
+  (:method ((construct ScopableC) themes &key (start-revision 0))
+    (declare (integer start-revision) (list themes))
+    (not (set-exclusive-or (themes construct :revision start-revision)
+			   themes))))
+
+
 (defmethod delete-construct :before ((construct ScopableC))
   (dolist (scope-assoc-to-delete (slot-p construct 'themes))
     (delete-construct scope-assoc-to-delete)))

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	Sun Mar 14 16:28:40 2010
@@ -47,7 +47,8 @@
 	   :test-delete-TypableC
 	   :test-delete-ScopableC
 	   :test-delete-AssociationC
-	   :test-delete-RoleC))
+	   :test-delete-RoleC
+	   :test-equivalent-PointerC))
 
 
 ;;TODO: test merge-constructs when merging was caused by an item-dentifier,
@@ -1337,6 +1338,24 @@
       (is-false (elephant:get-instances-by-class 'd::PlayerAssociationC)))))
 
 
+(test test-equivalent-PointerC ()
+  "Tests the functions equivalent-construct depending on PointerC
+   and its subclasses."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((p-1 (make-instance 'd::PointerC :uri "p-1"))
+	  (tid-1 (make-instance 'd:TopicIdentificationC :uri "tid-1"
+				:xtm-id "xtm-1"))
+	  (psi-1 (make-instance 'd:PersistentIdC :uri "psi-1")))
+      (is-true (d::equivalent-construct p-1 :uri "p-1"))
+      (is-false (d::equivalent-construct p-1 :uri "p-2"))
+      (is-true (d::equivalent-construct tid-1 :uri "tid-1" :xtm-id "xtm-1"))
+      (is-false (d::equivalent-construct tid-1 :uri "tid-2" :xtm-id "xtm-1"))
+      (is-false (d::equivalent-construct tid-1 :uri "tid-1" :xtm-id "xtm-2"))
+      (is-false (d::equivalent-construct tid-1 :uri "tid-2" :xtm-id "xtm-2"))
+      (is-true (d::equivalent-construct psi-1 :uri "psi-1"))
+      (is-false (d::equivalent-construct psi-1 :uri "psi-2")))))
+
+
 (defun run-datamodel-tests()
   "Runs all tests of this test-suite."
   (it.bese.fiveam:run! 'test-VersionInfoC)
@@ -1369,4 +1388,5 @@
   (it.bese.fiveam:run! 'test-delete-ScopableC)
   (it.bese.fiveam:run! 'test-delete-AssociationC)
   (it.bese.fiveam:run! 'test-delete-RoleC)
+  (it.bese.fiveam:run! 'test-equivalent-PointerC)
   )
\ No newline at end of file