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

Lukas Giessmann lgiessmann at common-lisp.net
Wed Feb 24 19:28:29 UTC 2010


Author: lgiessmann
Date: Wed Feb 24 14:28:28 2010
New Revision: 205

Log:
new-datamodel: fixed some problems with get-item-by-id and added some unit-tests

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	Wed Feb 24 14:28:28 2010
@@ -94,8 +94,7 @@
 (in-package :datamodel)
 
 
-;;TODO: fix this line (make-instance 'TopicC :from-oid (subseq topic-id 1)))))
-;;      in get-item-by-id
+
 ;;TODO: implement get-item-by-id(TopicC) + unit-tests
 ;;TODO: implement get-item-by-psi(TopicC) + unit-tests
 ;;TODO: implement get-item-by-locator(TopicC) + unit-tests
@@ -265,7 +264,8 @@
   (:documentation "Reifiable constructs as per TMDM."))
 
 
-(defpclass AssociationC(ReifiableConstructC ScopableC TypableC)
+(defpclass AssociationC(ReifiableConstructC ScopableC TypableC
+					    VersionedConstructC)
   ((roles :associate (RoleAssociationC association)
 	  :documentation "Contains all association-objects of all roles this
                           association contains.")
@@ -284,7 +284,7 @@
 	   :documentation "Associates this object with a player-association.")))
 
 
-(elephant:defpclass TopicMapC (ReifiableConstructC)
+(elephant:defpclass TopicMapC (ReifiableConstructC VersionedConstructC)
   ((topics :accessor topics
 	   :associate (TopicC in-topicmaps)
 	   :documentation "List of topics that explicitly belong to this TM.")
@@ -294,7 +294,7 @@
   (:documentation "Represnets a topic map."))
 
 
-(defpclass TopicC (ReifiableConstructC)
+(defpclass TopicC (ReifiableConstructC VersionedConstructC)
   ((topic-identifiers :associate (TopicIdAssociationC parent-construct)
 		      :documentation "Contains all association objects that
                                       relate a topic with its actual
@@ -749,7 +749,7 @@
 (defgeneric identified-construct (construct &key revision)
   (:documentation "Returns the identified-construct -> ReifiableConstructC or
                    TopicC that corresponds with the passed revision.")
-  (:method ((construct PointerC) &key (revision *TM-REVISION*))
+  (:method ((construct PointerC) &key (revision 0))
     (let ((assocs
 	   (map 'list #'parent-construct
 		(filter-slot-value-by-revision construct 'identified-construct
@@ -778,7 +778,7 @@
 (defgeneric topic-identifiers (construct &key revision)
   (:documentation "Returns the TopicIdentificationC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'topic-identifiers :start-revision revision)))
       (map 'list #'identifier assocs))))
@@ -791,7 +791,7 @@
                    If the passed identifer already identifies another object
                    the identified-constructs are merged.")
   (:method ((construct TopicC) (topic-identifier TopicIdentificationC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-ids
 	   (map 'list #'identifier (slot-p construct 'topic-identifiers)))
 	  (construct-to-be-merged
@@ -799,9 +799,7 @@
 	     (when (not (eql id-owner construct))
 	       id-owner))))
       (cond (construct-to-be-merged
-	     (merge-constructs (identified-construct construct-to-be-merged
-						     :revision revision)
-			       construct))
+	     (merge-constructs construct construct-to-be-merged :revision revision))
 	    ((find topic-identifier all-ids)
 	     (let ((ti-assoc (loop for ti-assoc in (slot-p construct
 							   'topic-identifiers)
@@ -834,7 +832,7 @@
 (defgeneric psis (construct &key revision)
   (:documentation "Returns the PersistentIdC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'psis :start-revision revision)))
       (map 'list #'identifier assocs))))
@@ -847,7 +845,7 @@
                    If the passed identifer already identifies another object
                    the identified-constructs are merged.")
   (:method ((construct TopicC) (psi PersistentIdC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-ids
 	   (map 'list #'identifier (slot-p construct 'psis)))
 	  (construct-to-be-merged
@@ -855,9 +853,8 @@
 	     (when (not (eql id-owner construct))
 	       id-owner))))
       (cond (construct-to-be-merged
-	     (merge-constructs (identified-construct construct-to-be-merged
-						     :revision revision)
-			       construct))
+	     (merge-constructs construct construct-to-be-merged
+			       :revision revision))
 	    ((find psi all-ids)
 	     (let ((psi-assoc (loop for psi-assoc in (slot-p construct 'psis)
 				when (eql (identifier psi-assoc) psi)
@@ -888,7 +885,7 @@
 (defgeneric locators (construct &key revision)
   (:documentation "Returns the SubjectLocatorC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'locators :start-revision revision)))
       (map 'list #'identifier assocs))))
@@ -901,7 +898,7 @@
                    If the passed identifer already identifies another object
                    the identified-constructs are merged.")
   (:method ((construct TopicC) (locator SubjectLocatorC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-ids
 	   (map 'list #'identifier (slot-p construct 'locators)))
 	  (construct-to-be-merged
@@ -909,9 +906,8 @@
 	     (when (not (eql id-owner construct))
 	       id-owner))))
       (cond (construct-to-be-merged
-	     (merge-constructs (identified-construct construct-to-be-merged
-						     :revision revision)
-			       construct))
+	     (merge-constructs construct construct-to-be-merged
+			       :revision revision))
 	    ((find locator all-ids)
 	     (let ((loc-assoc (loop for loc-assoc in (slot-p construct 'locators)
 				when (eql (identifier loc-assoc) locator)
@@ -942,7 +938,7 @@
 (defgeneric names (construct &key revision)
   (:documentation "Returns the NameC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'names :start-revision revision)))
       (map 'list #'characteristic assocs))))
@@ -955,7 +951,7 @@
                    If the passed name already owns another object
                    an error is thrown.")
   (:method ((construct TopicC) (name NameC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (when (not (eql (parent name) construct))
       (error "From add-name(): ~a can't be owned by ~a since it is already owned by the topic ~a"
 	     name construct (parent name)))
@@ -991,7 +987,7 @@
 (defgeneric occurrences (construct &key revision)
   (:documentation "Returns the OccurrenceC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'occurences :start-revision revision)))
       (map 'list #'characteristic assocs))))
@@ -1004,7 +1000,7 @@
                    If the passed occurrence already owns another object
                    an error is thrown.")
   (:method ((construct TopicC) (occurrence OccurrenceC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (when (not (eql (parent occurrence) construct))
       (error "From add-occurrence(): ~a can't be owned by ~a since it is already owned by the topic ~a"
 	     occurrence construct (parent occurrence)))
@@ -1040,7 +1036,7 @@
 (defgeneric player-in-roles (construct &key revision)
   (:documentation "Returns the RoleC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'player-in-roles :start-revision revision)))
       (map 'list #'parent-construct assocs))))
@@ -1049,7 +1045,7 @@
 (defgeneric used-as-type (construct &key revision)
   (:documentation "Returns the TypableC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'used-as-type :start-revision revision)))
       (map 'list #'typable-construct assocs))))
@@ -1058,7 +1054,7 @@
 (defgeneric used-as-theme (construct &key revision)
   (:documentation "Returns the ScopableC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'used-as-theme :start-revision revision)))
       (map 'list #'scopable-construct assocs))))
@@ -1067,7 +1063,7 @@
 (defgeneric reified-construct (construct &key revision)
   (:documentation "Returns the ReifiableConstructC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct TopicC) &key (revision *TM-REVISION*))
+  (:method ((construct TopicC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'reified-construct :start-revision revision)))
       (map 'list #'reifiable-construct assocs))))
@@ -1077,7 +1073,7 @@
   (:documentation "Returns all TopicMapS-obejcts where the constrict is
                    contained in."))
 
-(defmethod in-topicmaps ((topic TopicC) &key (revision *TM-REVISION*))
+(defmethod in-topicmaps ((topic TopicC) &key (revision 0))
   (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision))
 
 
@@ -1088,7 +1084,7 @@
    if the topic already existed in this revision and returns nil otherwise.
    If no item meeting the constraints was found, then the return value is either
    NIL or an error is thrown, depending on error-if-nil."
-  (declare (string topic-id) (integer revision) (string xtm-id))
+  (declare (string topic-id) (integer revision))
   (let ((result
 	 (if xtm-id
 	     (let ((possible-top-ids
@@ -1105,19 +1101,25 @@
 	       (when (and possible-top-ids
 			  (identified-construct (first possible-top-ids) :revision revision))
 		 (unless (= (length possible-top-ids) 1)
-		   (error (make-condition 'duplicate-identifier-error
-					  :message (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1"
-							   possible-top-ids topic-id xtm-id)
-					  :uri topic-id)))
+		   (error
+		    (make-condition 'duplicate-identifier-error
+				    :message (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1"
+						     possible-top-ids topic-id xtm-id)
+				    :uri topic-id)))
 		 (identified-construct (first possible-top-ids)
 				       :revision revision)
  	 	 ;no revision need not to be chaecked, since the revision
                  ;is implicitely checked by the function identified-construct
 		 ))
 	     (when (and (> (length topic-id) 0)
-			(eql (elt 0 topic-id) #\t)
+			(eql (elt topic-id 0) #\t)
 			(string-integer-p (subseq topic-id 1)))
-	       (elephant::controller-recreate-instance elephant::*store-controller* (subseq topic-id 1))))))
+	       (let ((top-from-oid
+		      (elephant::controller-recreate-instance
+		       elephant::*store-controller*
+		       (parse-integer (subseq topic-id 1)))))
+		 (when (find-item-by-revision top-from-oid revision)
+		   top-from-oid))))))
     (if (and error-if-nil (not result))
         (error "No such item (id: ~a, tm: ~a, rev: ~a)" topic-id xtm-id revision)
         result)))
@@ -1176,7 +1178,7 @@
 (defgeneric variants (construct &key revision)
   (:documentation "Returns all variants that correspond with the given revision
                    and that are associated with the passed construct.")
-  (:method ((construct NameC) &key (revision *TM-REVISION*))
+  (:method ((construct NameC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'variants
 					  :start-revision revision)))
@@ -1187,7 +1189,7 @@
   (:documentation "Adds the given theme-topic to the passed
                    scopable-construct.")
   (:method ((construct NameC) (variant VariantC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (when (not (eql (parent variant) construct))
       (error "From add-variant(): ~a can't be owned by ~a since it is already owned by the name ~a"
 	     variant construct (parent variant)))
@@ -1239,7 +1241,7 @@
   (:documentation "Returns the parent construct of the passed object that
                    corresponds with the given revision. The returned construct
                    can be a TopicC or a NameC.")
-  (:method ((construct CharacteristicC) &key (revision *TM-REVISION*))
+  (:method ((construct CharacteristicC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'parent
 					  :start-revision revision)))
@@ -1253,7 +1255,7 @@
 
 
 (defmethod add-parent ((construct CharacteristicC) (parent-construct TopicC)
-		       &key (revision *TM-REVISION*))
+		       &key (revision 0))
   (let ((already-set-topic
 	   (map 'list #'parent-construct
 		(filter-slot-value-by-revision construct 'parent
@@ -1280,7 +1282,7 @@
 
 
 (defmethod add-parent ((construct CharacteristicC) (parent-construct NameC)
-		       &key (revision *TM-REVISION*))
+		       &key (revision 0))
   (let ((already-set-name
 	   (map 'list #'characteristic
 		(filter-slot-value-by-revision construct 'parent
@@ -1441,7 +1443,7 @@
 (defgeneric roles (construct &key revision)
   (:documentation "Returns all topics that correspond with the given revision
                    as a scope for the given topic.")
-  (:method ((construct AssociationC) &key (revision *TM-REVISION*))
+  (:method ((construct AssociationC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'roles
 					  :start-revision revision)))
@@ -1451,7 +1453,7 @@
 (defgeneric add-role (construct role &key revision)
   (:documentation "Adds the given role to the passed association-construct.")
   (:method ((construct AssociationC) (role RoleC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-roles
 	   (map 'list #'role
 		(remove-if #'marked-as-deleted-p (slot-p construct 'roles)))))
@@ -1481,7 +1483,7 @@
       construct)))
 
 
-(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*))
+(defmethod in-topicmaps ((association AssociationC) &key (revision 0))
   (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision))
 
 
@@ -1494,7 +1496,7 @@
     (delete-construct assoc)))
 
 
-(defmethod parent ((construct RoleC) &key (revision *TM-REVISION*))
+(defmethod parent ((construct RoleC) &key (revision 0))
   "Returns the construct's parent corresponding to the given revision."
   (let ((valid-associations
 	 (filter-slot-value-by-revision construct 'parent
@@ -1504,7 +1506,7 @@
   
 
 (defmethod add-parent ((construct RoleC) (parent-construct AssociationC)
-			    &key (revision *TM-REVISION*))
+			    &key (revision 0))
   (let ((already-set-parent
 	   (map 'list #'parent
 		(filter-slot-value-by-revision construct 'parent
@@ -1542,7 +1544,7 @@
 (defgeneric player (construct &key revision)
   (:documentation "Returns the construct's player corresponding to
                    the given revision.")
-  (:method ((construct RoleC) &key (revision *TM-REVISION*))
+  (:method ((construct RoleC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'player
 					  :start-revision revision)))
@@ -1553,7 +1555,7 @@
 (defgeneric add-player (construct player-topic &key revision)
   (:documentation "Adds a topic as a player to a role in the given revision.")
   (:method ((construct RoleC) (player-topic TopicC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((already-set-player
 	   (map 'list #'player-topic
 		(filter-slot-value-by-revision construct 'player
@@ -1594,7 +1596,7 @@
 (defgeneric item-identifiers (construct &key revision)
   (:documentation "Returns the ItemIdentifierC-objects that correspond
                    with the passed construct and the passed version.")
-  (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
+  (:method ((construct ReifiableConstructC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'item-identifiers :start-revision revision)))
       (map 'list #'identifier assocs))))
@@ -1603,7 +1605,7 @@
 (defgeneric reifier (construct &key revision)
   (:documentation "Returns the reifier-topic that corresponds
                    with the passed construct and the passed version.")
-  (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
+  (:method ((construct ReifiableConstructC) &key (revision 0))
     (let ((assocs (filter-slot-value-by-revision
 		   construct 'item-identifiers :start-revision revision)))
       (when assocs ;assocs must be nil or a list with exactly one item
@@ -1627,7 +1629,7 @@
                    If the passed identifer already identifies another object
                    the identified-constructs are merged.")
   (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-ids
 	   (map 'list #'identifier (slot-p construct 'item-identifiers)))
 	  (construct-to-be-merged
@@ -1635,9 +1637,8 @@
 	     (when (not (eql id-owner construct))
 	       id-owner))))
       (cond (construct-to-be-merged
-	     (merge-constructs (identified-construct construct-to-be-merged
-						     :revision revision)
-			       construct))
+	     (merge-constructs construct construct-to-be-merged
+			       :revision revision))
 	    ((find item-identifier all-ids)
 	     (let ((ii-assoc (loop for ii-assoc in (slot-p construct
 							   'item-identifiers)
@@ -1673,7 +1674,7 @@
                    If the reifier-topic reifies already another construct
                    the reified-constructs are merged.")
   (:method ((construct ReifiableConstructC) (reifier-topic TopicC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((merged-reifier-topic
 	   (when (reifier construct)
 	     (merge-constructs (reifier construct) reifier-topic))))
@@ -1722,7 +1723,7 @@
 (defgeneric themes (construct &key revision)
   (:documentation "Returns all topics that correspond with the given revision
                    as a scope for the given topic.")
-  (:method ((construct ScopableC) &key (revision *TM-REVISION*))
+  (:method ((construct ScopableC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'themes
 					  :start-revision revision)))
@@ -1733,7 +1734,7 @@
   (:documentation "Adds the given theme-topic to the passed
                    scopable-construct.")
   (:method ((construct ScopableC) (theme-topic TopicC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((all-themes
 	   (map 'list #'theme-topic
 		(remove-if #'marked-as-deleted-p (slot-p construct 'themes)))))
@@ -1773,7 +1774,7 @@
 (defgeneric instance-of (construct &key revision)
   (:documentation "Returns the type topic that is set on the passed
                    revision.")
-  (:method ((construct TypableC) &key (revision *TM-REVISION*))
+  (:method ((construct TypableC) &key (revision 0))
     (let ((valid-associations
 	   (filter-slot-value-by-revision construct 'instance-of
 					  :start-revision revision)))
@@ -1786,7 +1787,7 @@
                    typed construct if there is no other type-topic
                    set at the same revision.")
   (:method ((construct TypableC) (type-topic TopicC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (let ((already-set-type
 	   (map 'list #'type-topic
 		(filter-slot-value-by-revision construct 'instance-of
@@ -1837,7 +1838,7 @@
 ;;; start hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defgeneric merge-constructs(construc-1 construct-2 &key revision)
   (:method ((construct-1 TopicMapConstructC) (construct-2 TopicMapconstructC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision 0))
     (or construct-1 construct-2 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	Wed Feb 24 14:28:28 2010
@@ -14,13 +14,16 @@
    :it.bese.FiveAM
    :fixtures
    :unittests-constants)
+  (:import-from :exceptions
+		duplicate-identifier-error)
   (:export :run-datamodel-tests
 	   :test-VersionInfoC
 	   :test-VersionedConstructC
 	   :test-ItemIdentifierC
 	   :test-PersistentIdC
 	   :test-SubjectLocatorC
-	   :test-TopicIdentificationC))
+	   :test-TopicIdentificationC
+	   :test-get-item-by-id))
 
 
 ;;TODO: test merges-constructs when merging was caused by an item-dentifier
@@ -302,6 +305,64 @@
 	(is-false (topic-identifiers topic-1 :revision revision-3-5)))))
 
 
+(test test-get-item-by-id ()
+    "Tests the function test-get-item-by-id."
+    (with-fixture with-empty-db (*db-dir*)
+      (let ((top-id-1 (make-instance 'TopicIdentificationC
+				     :uri "topid-1"
+				     :xtm-id "xtm-id-1"))
+	    (top-id-2 (make-instance 'TopicIdentificationC
+				     :uri "topid-2"
+				     :xtm-id "xtm-id-2"))
+	    (top-id-3-1 (make-instance 'TopicIdentificationC
+				       :uri "topid-3"
+				       :xtm-id "xtm-id-3"))
+	    (top-id-3-2 (make-instance 'TopicIdentificationC
+				       :uri "topid-3"
+				       :xtm-id "xtm-id-3"))
+	    (top-1 (make-instance 'TopicC))
+	    (top-2 (make-instance 'TopicC))
+	    (top-3 (make-instance 'TopicC))
+	    (revision 100)
+	    (revision-2 200))
+	(setf d:*TM-REVISION* revision)
+	(is-false (get-item-by-id "any-top-id"))
+	(signals error (is-false (get-item-by-id
+				  "any-top-id" :xtm-id "any-xtm-id"
+				  :error-if-nil t)))
+	(signals error (is-false (get-item-by-id "any-top-id" :error-if-nil t)))
+	(is-false (get-item-by-id "any-top-id" :xtm-id "any-xtm-id"))
+	(add-topic-identifier top-1 top-id-3-1 :revision revision)
+	(add-topic-identifier top-1 top-id-3-2 :revision revision)
+	(signals duplicate-identifier-error
+	  (get-item-by-id "topid-3" :xtm-id "xtm-id-3" :revision revision))
+	(add-topic-identifier top-2 top-id-1)
+	(add-topic-identifier top-2 top-id-2 :revision revision-2)
+	(is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1")))
+	(is (eql top-2 (get-item-by-id "topid-2" :xtm-id "xtm-id-2")))
+	(is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1"
+				       :revision 500)))
+	(is-false (get-item-by-id "topid-2" :xtm-id "xtm-id-2"
+				  :revision revision))
+	(delete-topic-identifier top-2 top-id-1 :revision revision-2)
+	(is-false (get-item-by-id "topid-1" :xtm-id "xtm-id-1"))
+	(is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1"
+				       :revision revision)))
+	(add-topic-identifier top-3 top-id-1 :revision revision-2)
+	(is (eql top-2 (get-item-by-id "topid-1" :xtm-id "xtm-id-1"
+				       :revision revision)))
+	(d::add-to-version-history top-3 :start-revision revision-2)
+	(is (eql top-3 (get-item-by-id "topid-1" :xtm-id "xtm-id-1")))
+	(is (eql top-3
+		 (get-item-by-id
+		  (concatenate 'string "t" (write-to-string
+					    (elephant::oid top-3))))))
+	(is-false (get-item-by-id
+		   (concatenate 'string "t" (write-to-string
+					     (elephant::oid top-3)))
+		   :revision revision)))))
+
+
 (defun run-datamodel-tests()
   (it.bese.fiveam:run! 'test-VersionInfoC)
   (it.bese.fiveam:run! 'test-VersionedConstructC)
@@ -309,4 +370,5 @@
   (it.bese.fiveam:run! 'test-PersistentIdC)
   (it.bese.fiveam:run! 'test-SubjectLocatorC)
   (it.bese.fiveam:run! 'test-TopicIdentificationC)
+  (it.bese.fiveam:run! 'test-get-item-by-id)
 )
\ No newline at end of file




More information about the Isidorus-cvs mailing list