[isidorus-cvs] r316 - in branches/new-datamodel/src: model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Sep 27 20:26:49 UTC 2010
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
More information about the Isidorus-cvs
mailing list