Changeset 290 for branches/new-datamodel

Timestamp:

04/29/10 10:17:20 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: fixed a problem when topic-merging was caused by reifying the same "ReifiableConstructC"; fixed a bug when two topics are merged and every of these topics reifies a construct that can't be merged with the other one.

Location:

branches/new-datamodel/src

Files:

• model/datamodel.lisp (modified) (3 diffs)
• unit_tests/datamodel_test.lisp (modified) (3 diffs)

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -3087 +3087 @@
   (:method ((construct ReifiableConstructC) (reifier-topic TopicC)
             &key (revision *TM-REVISION*))
+    (when (and (reified-construct reifier-topic :revision revision)
+               (not (equivalent-constructs construct
+                                           (reified-construct
+                                            reifier-topic :revision revision))))
+      (error (make-condition 'not-mergable-error
+                             :message (format nil "From add-reifier(): ~a and ~a can't be merged since the reified-constructs (~a ~a) are not mergable"
+                                              reifier-topic (reifier construct :revision revision) (reified-construct reifier-topic :revision revision) construct)
+                             :construct-1 construct
+                             :construct-2 (reified-construct reifier-topic :revision revision))))
     (let ((merged-reifier-topic
            (if (reifier construct :revision revision)
@@ -3853 +3862 @@
           (destination-reified (reified-construct destination
                                                   :revision revision)))
-      (unless (eql (type-of source-reified) (type-of destination-reified))
+      (when (and source-reified destination-reified
+                 (not (eql (type-of source-reified)
+                           (type-of destination-reified))))
         (error (make-condition 'not-mergable-error
                                :message (format nil "From move-reified-construct(): ~a and ~a can't be merged since the reified-constructs are not of the same type ~a ~a"
@@ -3869 +3880 @@
             (source-reified
              (delete-reifier source source-reified :revision revision)
-             (add-reifier destination source-reified :revision revision)
+             (add-reifier  source-reified destination :revision revision)
              source-reified)
             (destination-reified
-             (add-reifier destination destination-reified :revision revision)
+             (add-reifier destination-reified destination :revision revision)
              destination-reified)))))
 

branches/new-datamodel/src/unit_tests/datamodel_test.lisp ¶

@@ -89 +89 @@
            :test-merge-constructs-TopicC-6
            :test-merge-constructs-TopicC-7
-           :test-merge-constructs-TopicC-8))
+           :test-merge-constructs-TopicC-8
+           :test-merge-constructs-TopicC-9))
 
 
@@ -3555 +3556 @@
           (signals not-mergable-error (add-reifier occ-3 reifier-1))
           (is (eql (add-reifier occ-2 reifier-1) occ-1))
+          (is-false (set-exclusive-or (list occ-1 occ-3) (occurrences top-1)))
           (is-true (marked-as-deleted-p top-2))
-          (is-true (marked-as-deleted-p occ-2)))))))
+          (is-true (marked-as-deleted-p occ-2))
+          (is (= (length (d::versions top-1)) 2))
+          (is (= (length (d::versions top-2)) 1))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) rev-3)
+                                     (= (d::start-revision vi) rev-1)))
+                            (d::versions top-1)))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) 0)
+                                     (= (d::start-revision vi) rev-3)))
+                            (d::versions top-1)))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) rev-3)
+                                     (= (d::start-revision vi) rev-2)))
+                            (d::versions top-2)))
+          (is (= (length (slot-value occ-2 'd::parent)) 1))
+          (is (= (length (slot-value occ-1 'd::parent)) 1))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) rev-3)
+                                     (= (d::start-revision vi) rev-2)))
+                            (first (map 'list #'d::versions
+                                        (slot-value occ-2 'd::parent)))))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) rev-3)
+                                     (= (d::start-revision vi) rev-1)))
+                            (first (map 'list #'d::versions
+                                        (slot-value occ-1 'd::parent)))))
+          (is-true (find-if #'(lambda(vi)
+                                (and (= (d::end-revision vi) 0)
+                                     (= (d::start-revision vi) rev-3)))
+                            (first (map 'list #'d::versions
+                                        (slot-value occ-1 'd::parent))))))))))
+
+
+(test test-merge-constructs-TopicC-9 ()
+  "Tests the generic move-referenced-constructs corresponding to TopicC."
+  (with-fixture with-empty-db (*db-dir*)
+    (let ((rev-1 100)
+          (rev-2 200)
+          (rev-3 300)
+          (rev-4 400)
+          (psi-1 (make-construct 'PersistentIdC :uri "psi-1"))
+          (psi-2 (make-construct 'PersistentIdC :uri "psi-2")))
+      (let ((top-1 (make-construct 'TopicC :start-revision rev-2
+                                   :psis (list psi-2)))
+            (top-2 (make-construct 'TopicC :start-revision rev-2))
+            (top-3 (make-construct 'TopicC :start-revision rev-1))
+            (reifier-1 (make-construct 'TopicC :start-revision rev-1))
+            (reifier-2 (make-construct 'TopicC :start-revision rev-2
+                                       :psis (list psi-1)))
+            (reifier-3 (make-construct 'TopicC :start-revision rev-1))
+            (reifier-4 (make-construct 'TopicC :start-revision rev-1))
+            (type-1 (make-construct 'TopicC :start-revision rev-1))
+            (type-2 (make-construct 'TopicC :start-revision rev-1)))
+        (let ((occ-1 (make-construct 'OccurrenceC
+                                     :start-revision rev-2
+                                     :instance-of type-1
+                                     :charvalue "occ"
+                                     :reifier reifier-1
+                                     :parent top-1))
+              (occ-2 (make-construct 'OccurrenceC
+                                     :start-revision rev-2
+                                     :instance-of type-2
+                                     :charvalue "occ"
+                                     :reifier reifier-3
+                                     :parent top-2))
+              (occ-3 (make-construct 'OccurrenceC
+                                     :start-revision rev-1
+                                     :instance-of type-1
+                                     :charvalue "occ"
+                                     :reifier reifier-4
+                                     :parent top-3)))
+          (setf *TM-REVISION* rev-3)
+          (is (eql (reifier occ-2) reifier-3))
+          (signals not-mergable-error (add-reifier occ-1 reifier-3))
+          (is (eql occ-1 (add-reifier occ-1 reifier-2)))
+          (is-true (marked-as-deleted-p reifier-2))
+          (is-false (set-exclusive-or (list psi-1) (psis reifier-1)))
+          (setf *TM-REVISION* rev-4)
+          (is (eql (add-reifier occ-1 reifier-4) occ-3))
+          (is-true (marked-as-deleted-p top-1))
+          (is-false (marked-as-deleted-p top-3))
+          (is-false (set-exclusive-or (list psi-2) (psis top-3)))
+          (is-false (marked-as-deleted-p top-2))
+          (is-false (set-exclusive-or (list occ-2) (occurrences top-2))))))))
 
 
 ;;TODO: merge topics caused by variant-item-identifiers
-;;TODO: mrege topics caused by reifying the same reified-construct
 ;;TODO: merge associations caused by a merge of their characteristics
 
@@ -3632 +3717 @@
   (it.bese.fiveam:run! 'test-merge-constructs-TopicC-7)
   (it.bese.fiveam:run! 'test-merge-constructs-TopicC-8)
+  (it.bese.fiveam:run! 'test-merge-constructs-TopicC-9)
   )