Author: lgiessmann Date: Mon Sep 27 16:26:49 2010 New Revision: 316

Log: new-datamodel: adapted the unit-test exporter-test:test-fragments-xtm1.0-versions to the new data model; fixed a bug when creating FragmentC objects-> topics referenced by variants of the main topic are also added as topic stubs

Modified: branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp

Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Mon Sep 27 16:26:49 2010 @@ -72,6 +72,11 @@ (themes characteristic :revision revision) (when (instance-of characteristic :revision revision) (list (instance-of characteristic :revision revision))) + (when (and (typep characteristic 'NameC) + (variants characteristic :revision revision)) + (remove-if #'null + (loop for var in (variants characteristic :revision revision) + append (find-referenced-topics var :revision revision)))) (when (and (typep characteristic 'OccurrenceC) (> (length (charvalue characteristic)) 0) (eq ## (elt (charvalue characteristic) 0)))

Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Mon Sep 27 16:26:49 2010 @@ -1140,15 +1140,16 @@ ((and current-version-info (= (end-revision current-version-info) 0)) (setf (end-revision current-version-info) start-revision) - (make-instance 'VersionInfoC - :start-revision start-revision - :end-revision end-revision - :versioned-construct construct)) + (let ((vi (make-instance 'VersionInfoC + :start-revision start-revision + :end-revision end-revision))) + (elephant:add-association vi 'versioned-construct construct))) (t - (make-instance 'VersionInfoC - :start-revision start-revision - :end-revision end-revision - :versioned-construct construct)))))))) + (let ((vi (make-instance 'VersionInfoC + :start-revision start-revision + :end-revision end-revision))) + (elephant:add-association vi 'versioned-construct construct))))))))) +

(defmethod marked-as-deleted-p ((construct VersionedConstructC)) @@ -4222,7 +4223,7 @@ construct-1))) (move-referenced-constructs newer-tm older-tm :revision revision) (dolist (top-or-assoc (append (topics newer-tm) (associations newer-tm))) - (add-to-tm top-or-assoc top-or-assoc)) + (add-to-tm older-tm top-or-assoc)) (add-to-version-history older-tm :start-revision revision) (mark-as-deleted newer-tm :revision revision) (when (exist-in-version-history-p newer-tm)

Modified: branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp Mon Sep 27 16:26:49 2010 @@ -390,12 +390,10 @@ when (string= (uri item) psi) return (identified-construct item))) (t100-start-revision (d::start-revision (first (d::versions t100))))) - (d:get-fragments t100-start-revision) (let ((t100-fragment (loop for item in (elephant:get-instances-by-class 'FragmentC) when (eq (topic item) t100) return item))) - (with-open-file (stream *out-xtm1.0-file* :direction :output) (write-string (export-xtm-fragment t100-fragment :xtm-format '1.0) stream))))

@@ -443,7 +441,9 @@ (with-fixture merge-test-db () (handler-case (delete-file *out-xtm1.0-file*)(error () )) ;deletes file - if exist (export-xtm *out-xtm1.0-file* :revision fixtures::revision1 :xtm-format '1.0) - (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) + (let ((document + (dom:document-element + (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))) (t100-occurrences-resourceData (list "The ISO 19115 standard ..." "2003-01-01"))) ;local value->no type (check-document-structure document 47 7 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") @@ -1121,18 +1121,17 @@ (let ((new-t100 (loop for item in (elephant:get-instances-by-class 'd:PersistentIdC) when (string= (uri item) new-t100-psi) - return (identified-construct item)))) + return (identified-construct item :revision fixtures::revision3)))) (d:get-fragments fixtures::revision3) (let ((fragment (loop for item in (elephant:get-instances-by-class 'd:FragmentC) when (eq (topic item) new-t100) return item))) (with-open-file (stream *out-xtm1.0-file* :direction :output) (write-string (export-xtm-fragment fragment :xtm-format '1.0) stream)))) - (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) - (check-document-structure document 6 0 :ns-uri *xtm1.0-ns*) + (check-document-structure document 9 1 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname @@ -1145,6 +1144,12 @@ (check-topic-id topic)) ((string= href core-display-psi) (check-topic-id topic)) + ((string= href constants:*type-instance-psi*) + (check-topic-id topic)) + ((string= href constants:*type-psi*) + (check-topic-id topic)) + ((string= href constants:*instance-psi*) + (check-topic-id topic)) ((string= href t50a-psi) (check-topic-id topic)) ((string= href t3-psi) @@ -1154,28 +1159,35 @@ ((string= href new-t100-psi) (check-topic-id topic) (check-single-instanceOf document topic t3-psi :xtm-format '1.0) - (loop for occurrence across (xpath-child-elems-by-qname topic *xtm1.0-ns* "occurrence") + (loop for occurrence across (xpath-child-elems-by-qname + topic *xtm1.0-ns* "occurrence") do (let ((resourceRef (let ((resourceRef-nodes - (xpath-child-elems-by-qname occurrence *xtm1.0-ns* "resourceRef"))) + (xpath-child-elems-by-qname + occurrence *xtm1.0-ns* "resourceRef"))) (is (= (length resourceRef-nodes) 1)) - (dom:get-attribute-ns (elt resourceRef-nodes 0) *xtm1.0-xlink* "href"))) + (dom:get-attribute-ns (elt resourceRef-nodes 0) + *xtm1.0-xlink* "href"))) (instanceOf (let ((instanceOf-nodes - (xpath-child-elems-by-qname occurrence *xtm1.0-ns* "instanceOf"))) + (xpath-child-elems-by-qname + occurrence *xtm1.0-ns* "instanceOf"))) (is (= (length instanceOf-nodes) 1)) (let ((topicRef-nodes (xpath-child-elems-by-qname - (elt instanceOf-nodes 0) *xtm1.0-ns* "topicRef"))) + (elt instanceOf-nodes 0) *xtm1.0-ns* + "topicRef"))) (is (= (length topicRef-nodes) 1)) (get-subjectIndicatorRef-by-ref document (dom:get-attribute-ns (elt topicRef-nodes 0) *xtm1.0-xlink* "href")))))) (cond - ((string= resourceRef (first new-t100-occurrence-resourceRef-merge-2)) + ((string= resourceRef + (first new-t100-occurrence-resourceRef-merge-2)) (is (string= instanceOf t55-psi))) - ((string= resourceRef (second new-t100-occurrence-resourceRef-merge-2)) + ((string= resourceRef + (second new-t100-occurrence-resourceRef-merge-2)) (is (string= instanceOf t55-psi))) (t (is-true