[isidorus-cvs] r470 - in trunk/src: json/JTM json/isidorus-json model unit_tests xml/rdf xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Tue May 10 15:54:42 UTC 2011
Author: lgiessmann
Date: Tue May 10 11:54:42 2011
New Revision: 470
Log:
fixed ticket #111 and adapted all unit-tests
Modified:
trunk/src/json/JTM/jtm_importer.lisp
trunk/src/json/isidorus-json/json_exporter.lisp
trunk/src/json/isidorus-json/json_importer.lisp
trunk/src/model/changes.lisp
trunk/src/model/datamodel.lisp
trunk/src/unit_tests/exporter_xtm1.0_test.lisp
trunk/src/unit_tests/exporter_xtm2.0_test.lisp
trunk/src/unit_tests/importer_test.lisp
trunk/src/unit_tests/json_test.lisp
trunk/src/unit_tests/jtm_test.lisp
trunk/src/unit_tests/rdf_importer_test.lisp
trunk/src/unit_tests/reification_test.lisp
trunk/src/unit_tests/sparql_test.lisp
trunk/src/xml/rdf/exporter.lisp
trunk/src/xml/rdf/map_to_tm.lisp
trunk/src/xml/xtm/exporter.lisp
trunk/src/xml/xtm/exporter_xtm1.0.lisp
trunk/src/xml/xtm/exporter_xtm2.0.lisp
Modified: trunk/src/json/JTM/jtm_importer.lisp
==============================================================================
--- trunk/src/json/JTM/jtm_importer.lisp (original)
+++ trunk/src/json/JTM/jtm_importer.lisp Tue May 10 11:54:42 2011
@@ -492,7 +492,6 @@
(get-item :ITEM--IDENTIFIERS jtm-list)
:prefixes prefixes))
(datatype (get-item :DATATYPE jtm-list))
- (scope (get-item :SCOPE jtm-list))
(value (get-item :VALUE jtm-list))
(reifier (get-item :REIFIER jtm-list))
(parent-references (get-item :PARENT jtm-list))
@@ -501,15 +500,21 @@
(list parent)
(when parent-references
(get-items-from-jtm-references
- parent-references :revision revision :prefixes prefixes)))))
+ parent-references :revision revision :prefixes prefixes))))
+ (scopes (when local-parent
+ (remove-duplicates
+ (append
+ (get-items-from-jtm-references
+ (get-item :SCOPE jtm-list)
+ :revision revision :prefixes prefixes)
+ (themes (first local-parent) :revision revision))))))
(when (/= (length local-parent) 1)
(error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-list(): the JTM variant ~a must have exactly one parent set in its members." jtm-list))))
(make-construct 'VariantC :start-revision revision
:item-identifiers iis
:datatype (if datatype datatype *xml-string*)
:charvalue value
- :themes (get-items-from-jtm-references
- scope :revision revision :prefixes prefixes)
+ :themes scopes
:parent (first local-parent)
:reifier (when reifier
(get-item-from-jtm-reference
Modified: trunk/src/json/isidorus-json/json_exporter.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_exporter.lisp (original)
+++ trunk/src/json/isidorus-json/json_exporter.lisp Tue May 10 11:54:42 2011
@@ -101,9 +101,12 @@
(identifiers-to-json-string instance :what 'item-identifiers
:revision revision)))
(scope
- (concat "\"scopes\":" (ref-topics-to-json-string
- (themes instance :revision revision)
- :revision revision)))
+ (concat "\"scopes\":"
+ (ref-topics-to-json-string
+ (set-difference (themes instance :revision revision)
+ (when-do name (parent instance :revision revision)
+ (themes name :revision revision)))
+ :revision revision)))
(resourceX
(let ((value
(when (slot-boundp instance 'charvalue)
Modified: trunk/src/json/isidorus-json/json_importer.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_importer.lisp (original)
+++ trunk/src/json/isidorus-json/json_importer.lisp Tue May 10 11:54:42 2011
@@ -289,7 +289,7 @@
(getf json-decoded-list :itemIdentities)))
(themes
(remove-duplicates
- (append (d:themes name)
+ (append (d:themes name :revision start-revision)
(json-to-scope (getf json-decoded-list :scopes)
start-revision))))
(variant-value
Modified: trunk/src/model/changes.lisp
==============================================================================
--- trunk/src/model/changes.lisp (original)
+++ trunk/src/model/changes.lisp Tue May 10 11:54:42 2011
@@ -66,12 +66,17 @@
(defmethod find-referenced-topics ((characteristic CharacteristicC)
&key (revision *TM-REVISION*))
- "characteristics are scopable + typable + reifiable"
+ "Characteristics are scopable + typable + reifiable.
+ Note the tmdm:topic-name is ignored if it is only set
+ as a nametype."
(append
(when (reifier characteristic :revision revision)
(list (reifier characteristic :revision revision)))
(themes characteristic :revision revision)
- (when (instance-of characteristic :revision revision)
+ (when (and (not (and (typep characteristic 'NameC)
+ (eql (instance-of characteristic :revision revision)
+ (get-item-by-psi *topic-name-psi* :revision revision))))
+ (instance-of characteristic :revision revision))
(list (instance-of characteristic :revision revision)))
(when (and (typep characteristic 'NameC)
(variants characteristic :revision revision))
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Tue May 10 11:54:42 2011
@@ -1575,10 +1575,9 @@
(and sl-provided-p
(some (lambda (psi) (string-starts-with (uri psi) source-locator))
(psis top :revision 0))))
- (unless sl-provided-p
- (mapc (lambda(psi)(mark-as-deleted psi :revision revision
- :source-locator source-locator))
- (psis top :revision 0)))
+ (mapc (lambda(psi)(mark-as-deleted psi :revision revision
+ :source-locator source-locator))
+ (psis top :revision 0))
(mapc (lambda(sl)(mark-as-deleted sl :revision revision
:source-locator source-locator))
(locators top :revision 0))
Modified: trunk/src/unit_tests/exporter_xtm1.0_test.lisp
==============================================================================
--- trunk/src/unit_tests/exporter_xtm1.0_test.lisp (original)
+++ trunk/src/unit_tests/exporter_xtm1.0_test.lisp Tue May 10 11:54:42 2011
@@ -17,7 +17,7 @@
(let ((document (dom:document-element
(cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))
(topic-counter 0))
- (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :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
@@ -99,7 +99,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm1.0-file* :xtm-format :1.0)
(let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :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
@@ -141,7 +141,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm1.0-file* :xtm-format :1.0)
(let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :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
@@ -200,7 +200,7 @@
(export-as-xtm *out-xtm1.0-file* :xtm-format :1.0)
(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 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :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
@@ -234,7 +234,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm1.0-file* :xtm-format :1.0)
(let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :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
@@ -294,7 +294,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm1.0-file* :xtm-format :1.0)
(let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 39 2 :ns-uri *xtm1.0-ns*)
(loop for association across (xpath-child-elems-by-qname document *xtm1.0-ns* "association")
do (let ((instanceOfs (xpath-child-elems-by-qname association *xtm1.0-ns* "instanceOf")))
(is (= (length instanceOfs) 1))
@@ -445,7 +445,7 @@
(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*)
+ (check-document-structure document 48 7 :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
@@ -632,7 +632,7 @@
(export-as-xtm *out-xtm1.0-file* :revision fixtures::revision2 :xtm-format :1.0)
(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 48 7 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 49 7 :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
@@ -846,7 +846,7 @@
(export-as-xtm *out-xtm1.0-file* :revision fixtures::revision3 :xtm-format :1.0)
(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 48 8 :ns-uri *xtm1.0-ns*)
+ (check-document-structure document 49 8 :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
Modified: trunk/src/unit_tests/exporter_xtm2.0_test.lisp
==============================================================================
--- trunk/src/unit_tests/exporter_xtm2.0_test.lisp (original)
+++ trunk/src/unit_tests/exporter_xtm2.0_test.lisp Tue May 10 11:54:42 2011
@@ -558,7 +558,7 @@
(cxml:parse-file *out-xtm2.0-file*
(cxml-dom:make-dom-builder))))
(topic-counter 0))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across
(xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
@@ -638,7 +638,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm2.0-file*)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href"))))
@@ -684,7 +684,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm2.0-file*)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href"))))
@@ -751,7 +751,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm2.0-file*)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href"))))
@@ -788,7 +788,7 @@
(with-fixture refill-test-db ()
(export-as-xtm *out-xtm2.0-file*)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:node-value (dom:get-attribute-node subjectIdentifier "href"))))
@@ -857,7 +857,7 @@
(with-fixture refill-test-db()
(export-as-xtm *out-xtm2.0-file*)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 38 2)
+ (check-document-structure document 39 2)
(let ((assoc-1 (elt (xpath-child-elems-by-qname document *xtm2.0-ns* "association") 0))
(assoc-2 (elt (xpath-child-elems-by-qname document *xtm2.0-ns* "association") 1)))
(let ((assoc-1-type (get-subjectIdentifier-by-ref
@@ -1093,7 +1093,7 @@
(handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist
(export-as-xtm *out-xtm2.0-file* :revision fixtures::revision1)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 47 7)
+ (check-document-structure document 48 7)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:get-attribute subjectIdentifier "href")))
@@ -1328,7 +1328,7 @@
(handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist
(export-as-xtm *out-xtm2.0-file* :revision fixtures::revision2)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 48 7)
+ (check-document-structure document 49 7)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:get-attribute subjectIdentifier "href")))
@@ -1611,7 +1611,7 @@
(handler-case (delete-file *out-xtm2.0-file*)(error () )) ;deletes file - if exist
(export-as-xtm *out-xtm2.0-file* :revision fixtures::revision3)
(let ((document (dom:document-element (cxml:parse-file *out-xtm2.0-file* (cxml-dom:make-dom-builder)))))
- (check-document-structure document 48 8)
+ (check-document-structure document 49 8)
(loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
do (loop for subjectIdentifier across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
do (let ((href (dom:get-attribute subjectIdentifier "href")))
Modified: trunk/src/unit_tests/importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/importer_test.lisp (original)
+++ trunk/src/unit_tests/importer_test.lisp Tue May 10 11:54:42 2011
@@ -213,9 +213,9 @@
(is (= 3 (length (occurrences top-t301 :revision rev-1)))) ;after merge
(is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
(uri (first (psis top-sup-sub :revision rev-1)))))))
- ;34 topics in 35 topic elements in notificationbase.xtm and 13
+ ;34 topics in 35 topic elements in notificationbase.xtm and 14
;core topics
- (is (= (+ 34 13) (length (elephant:get-instances-by-class 'TopicC))))))
+ (is (= (+ 34 14) (length (elephant:get-instances-by-class 'TopicC))))))
(test test-from-role-elem
"Test the form-role-elem function of the importer"
@@ -367,7 +367,7 @@
(xtm-importer:setup-repository *t100.xtm* dir :xtm-id *TEST-TM*
:tm-id "http://www.isidor.us/unittests/topic-t100")
(open-tm-store dir)
- (is (= 25 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db +std topics
+ (is (= 26 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db + std topics
(is-true (get-item-by-id "t100" :revision 0)) ;; main topic
(is-true (get-item-by-id "t3a" :revision 0)) ;; instanceOf
(is-true (get-item-by-id "t50a" :revision 0)) ;; scope
@@ -444,14 +444,14 @@
:xtm-id *TEST-TM* :xtm-format :1.0)
(setf *TM-REVISION* 0)
(open-tm-store dir)
- ;13 + (23 core topics)
- (is (= 36 (length (elephant:get-instances-by-class 'TopicC))))
+ ;14 + (23 core topics)
+ (is (= 37 (length (elephant:get-instances-by-class 'TopicC))))
;2 + (11 instanceOf)
(is (= 13 (length (elephant:get-instances-by-class 'AssociationC))))
;4 + (22 instanceOf-associations)
(is (= 26 (length (elephant:get-instances-by-class 'RoleC))))
- ;23 + (13 core topics)
- (is (= 36 (length (elephant:get-instances-by-class 'PersistentIdC))))
+ ;23 + (14 core topics)
+ (is (= 37 (length (elephant:get-instances-by-class 'PersistentIdC))))
(is (= 0 (length (elephant:get-instances-by-class 'SubjectLocatorC))))
;2 + (0 core topics)
(is (= 2 (length (elephant:get-instances-by-class 'OccurrenceC))))
Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp (original)
+++ trunk/src/unit_tests/json_test.lisp Tue May 10 11:54:42 2011
@@ -294,17 +294,10 @@
"http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
(string= (second (getf variant :itemIdentities))
"http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
- (is (= (length (getf variant :scopes)) 2))
+ (is (= (length (getf variant :scopes)) 1))
(is (= (length (first (getf variant :scopes))) 1))
- (is (= (length (second (getf variant :scopes))) 1))
- (is (or (string= (first (first (getf variant :scopes)))
- "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
- (string= (first (first (getf variant :scopes)))
- "http://psi.egovpt.org/types/long-name")))
- (is (or (string= (first (second (getf variant :scopes)))
- "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
- (string= (first (second (getf variant :scopes)))
- "http://psi.egovpt.org/types/long-name")))
+ (is (string= (first (first (getf variant :scopes)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))
(is-false (getf variant :resourceRef))
(is (string= (getf (getf variant :resourceData) :datatype)
"http://www.w3.org/2001/XMLSchema#string"))
@@ -559,11 +552,11 @@
(with-fixture initialize-destination-db (dir)
(open-tm-store dir)
(xtm-importer:init-isidorus)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 14))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
(json-importer:import-from-isidorus-json *t64*)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 15))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 16))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
(let ((core-tm
@@ -577,7 +570,7 @@
"http://www.isidor.us/unittests/testtm")
return tm)))
(is-true (and core-tm test-tm))
- (is (= (length (topics core-tm)) 13))
+ (is (= (length (topics core-tm)) 14))
(is (= (length (associations core-tm)) 0))
(is (= (length (topics test-tm)) (+ 2 3)))
(is (= (length (associations test-tm)) 1))))))
@@ -646,7 +639,7 @@
(xtm-importer:init-isidorus)
(json-importer:import-from-isidorus-json *t64*)
(json-importer:import-from-isidorus-json *t100-3*)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28)) ;13 new topics
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29)) ;14 new topics
(is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 5)) ;4 new associations
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
(let ((core-tm
@@ -660,7 +653,7 @@
"http://www.isidor.us/unittests/testtm")
return tm)))
(is-true (and core-tm test-tm))
- (is (= (length (topics core-tm)) 13))
+ (is (= (length (topics core-tm)) 14))
(is (= (length (associations core-tm)) 0))
(is (= (length (topics test-tm)) (+ 17 3)))
(is (= (length (associations test-tm)) 5))))))
@@ -1004,11 +997,11 @@
(with-fixture initialize-destination-db (dir)
(open-tm-store dir)
(xtm-importer:init-isidorus)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 14))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
(json-importer:import-from-isidorus-json *t100-1*)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 18))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
(let ((core-tm
@@ -1023,7 +1016,7 @@
return tm)))
(is-true (and core-tm test-tm)))
(json-importer:import-from-isidorus-json *t100-2*)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 18))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
(let ((core-tm
@@ -1376,6 +1369,9 @@
"http://www.topicmaps.org/xtm/1.0/core.xtm#topic")
(is (= (length topic-psis) 1)))
((string= (first topic-psis)
+ "http://psi.topicmaps.org/iso13250/model/topic-name")
+ (is (= (length topic-psis) 1)))
+ ((string= (first topic-psis)
"http://www.topicmaps.org/xtm/1.0/core.xtm#association")
(is (= (length topic-psis) 1)))
((string= (first topic-psis)
Modified: trunk/src/unit_tests/jtm_test.lisp
==============================================================================
--- trunk/src/unit_tests/jtm_test.lisp (original)
+++ trunk/src/unit_tests/jtm_test.lisp Tue May 10 11:54:42 2011
@@ -1570,6 +1570,11 @@
:locators
(list (make-construct 'SubjectLocatorC
:uri "http://some.where/sl-1"))))
+ (type-2 (make-construct
+ 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*))))
(parent-1 (make-construct
'TopicC :start-revision 100
:psis
@@ -1607,7 +1612,7 @@
(is-false (set-exclusive-or (themes name-1 :revision 0) (list scope-1)))
(is-false (themes name-2 :revision 0))
(is (eql (instance-of name-1 :revision 0) type-1))
- (is-false (instance-of name-2 :revision 0))
+ (is (eql (instance-of name-2 :revision 0) type-2))
(is-false (set-exclusive-or
(map 'list #'d:charvalue (variants name-1 :revision 0))
(list "var-1" "var-2") :test #'string=))
@@ -1864,6 +1869,11 @@
:item-identifiers
(list (make-construct 'ItemIdentifierC
:uri "http://some.where/tm-1"))))
+ (topic-name (make-construct
+ 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*))))
(tm-2 (make-construct
'TopicMapC :start-revision 100
:item-identifiers
@@ -1878,8 +1888,8 @@
(list tm-1 tm-2) :revision 100 :prefixes prefixes)))
(is (= (length tops) 5))
(is (= (length (remove-duplicates tops)) 4))
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 4))
- (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 3))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 5))
+ (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 4))
(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 4))
(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
(is-false (elephant:get-instances-by-class 'NameC))
@@ -1909,8 +1919,8 @@
(top-2 (jtm::merge-topic-from-jtm-list
(json:decode-json-from-string j-top-2)
(list tm-1 tm-2) :revision 100 :prefixes prefixes)))
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 7))
- (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 6))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 8))
+ (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7))
(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5))
(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
(is (= (length (elephant:get-instances-by-class 'NameC)) 2))
@@ -1922,7 +1932,8 @@
(is (= (length (names top-1 :revision 0)) 2))
(is-true (find-if #'(lambda(name)
(and (string= (charvalue name) "name-1")
- (not (instance-of name :revision 0))
+ (eql (instance-of name :revision 0)
+ topic-name)
(not (themes name :revision 0))
(not (variants name :revision 0))
(not (reifier name :revision 0))
@@ -1931,7 +1942,8 @@
(is-true
(find-if #'(lambda(name)
(and (string= (charvalue name) "name-2")
- (not (instance-of name :revision 0))
+ (eql (instance-of name :revision 0)
+ topic-name)
(= (length (themes name :revision 0)) 1)
(= (length (locators (first (themes name :revision 0))
:revision 0)) 1)
@@ -1995,8 +2007,8 @@
(json:decode-json-from-string j-top-5))
(list tm-1 tm-2) :revision 200 :prefixes prefixes)))
(is (= (length (remove-duplicates tops)) 4))
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 7))
- (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 6))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 8))
+ (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7))
(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5))
(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
(is (= (length (elephant:get-instances-by-class 'NameC)) 2))
@@ -2310,10 +2322,14 @@
(asdf:component-pathname
(asdf:find-component constants:*isidorus-system* "unit_tests"))
"jtm_1.1_test.jtm"))))
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*)))
(let ((tm (import-construct-from-jtm-string
jtm-str :revision 100 :jtm-format :1.1)))
(is-true tm)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
(loop for top in (elephant:get-instances-by-class 'TopicC) do
(cond ((and
(= (length (psis top :revision 0)) 1)
@@ -2343,6 +2359,19 @@
(is (eql tm (first (in-topicmaps top :revision 0)))))
((and
(= (length (psis top :revision 0)) 1)
+ (string= (uri (first (psis top :revision 0)))
+ "http://psi.topicmaps.org/iso13250/model/topic-name"))
+ (is-false (used-as-theme top :revision 0))
+ (is-true (used-as-type top :revision 0))
+ (is-false (player-in-roles top :revision 0))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is-false (in-topicmaps top :revision 0)))
+ ((and
+ (= (length (psis top :revision 0)) 1)
(find (uri (first (psis top :revision 0)))
(list "http://psi.topicmaps.org/iso13250/model/type-instance"
"http://psi.topicmaps.org/iso13250/model/type"
@@ -2412,7 +2441,7 @@
(= (length (psis top :revision 0)) 1)
(find
(uri (first (psis top :revision 0)))
- (list
+ (list
"http://some.where/tmsparql/author/goethe"
"http://some.where/tmsparql/author"
"http://some.where/psis/poem/zauberlehrling"
@@ -2447,16 +2476,21 @@
(asdf:component-pathname
(asdf:find-component constants:*isidorus-system* "unit_tests"))
"jtm_1.1_test.jtm"))))
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*)))
(let ((tm (import-construct-from-jtm-string
jtm-str :revision 100 :jtm-format :1.1)))
(is-true tm)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
(loop for top in (elephant:get-instances-by-class 'TopicC) do
(cond ((and
(= (length (psis top :revision 0)) 1)
(find
(uri (first (psis top :revision 0)))
(list
+ "http://psi.topicmaps.org/iso13250/model/topic-name"
"http://psi.topicmaps.org/iso13250/model/type-instance"
"http://psi.topicmaps.org/iso13250/model/type"
"http://psi.topicmaps.org/iso13250/model/instance"
@@ -2585,131 +2619,150 @@
(asdf:component-pathname
(asdf:find-component constants:*isidorus-system* "unit_tests"))
"jtm_1.0_test.jtm")))
+ (topic-name
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*))))
(tm (import-construct-from-jtm-string
jtm-str :revision 100 :jtm-format :1.0
:tm-id "http://some.where/jtm-tm")))
(is-true tm)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
- (loop for top in (elephant:get-instances-by-class 'TopicC) do
- (cond ((and
- (= (length (psis top :revision 0)) 1)
- (find
- (uri (first (psis top :revision 0)))
- (list
- "http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#association"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#class"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
- "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
- :test #'string=))
- (is-false (used-as-theme top :revision 0))
- (is-false (used-as-type top :revision 0))
- (is-false (player-in-roles top :revision 0))
- (is-false (reified-construct top :revision 0))
- (is-false (occurrences top :revision 0))
- (is-false (names top :revision 0))
- (is-false (item-identifiers top :revision 0))
- (is-false (locators top :revision 0))
- (is (= (length (in-topicmaps top :revision 0)) 1))
- (is (eql tm (first (in-topicmaps top :revision 0)))))
- ((and
- (= (length (psis top :revision 0)) 1)
- (find (uri (first (psis top :revision 0)))
- (list "http://psi.topicmaps.org/iso13250/model/type-instance"
- "http://psi.topicmaps.org/iso13250/model/type"
- "http://psi.topicmaps.org/iso13250/model/instance")
- :test #'string=))
- (is-false (used-as-theme top :revision 0))
- (is (= (length (used-as-type top :revision 0)) 29))
- (is-false (player-in-roles top :revision 0))
- (is-false (reified-construct top :revision 0))
- (is-false (occurrences top :revision 0))
- (is-false (names top :revision 0))
- (is-false (item-identifiers top :revision 0))
- (is-false (locators top :revision 0))
- (is (= (length (in-topicmaps top :revision 0)) 1))
- (is (eql tm (first (in-topicmaps top :revision 0)))))
- ((and
- (= (length (psis top :revision 0)) 1)
- (find
- (uri (first (psis top :revision 0)))
- (list
- "http://some.where/tmsparql/written-by"
- "http://some.where/tmsparql/written"
- "http://some.where/tmsparql/writer"
- "http://some.where/tmsparql/first-name"
- "http://some.where/tmsparql/last-name"
- "http://some.where/tmsparql/title"
- "http://some.where/tmsparql/date-of-birth"
- "http://some.where/tmsparql/date-of-death"
- "http://some.where/tmsparql/years"
- "http://some.where/tmsparql/isDead"
- "http://some.where/tmsparql/isAlive"
- "http://some.where/tmsparql/poem-content")
- :test 'string=))
- (is-false (used-as-theme top :revision 0))
- (is-true (used-as-type top :revision 0))
- (is (= (length (player-in-roles top :revision 0)) 1))
- (is-false (reified-construct top :revision 0))
- (is-false (occurrences top :revision 0))
- (is-false (names top :revision 0))
- (is-false (item-identifiers top :revision 0))
- (is-false (locators top :revision 0))
- (is (= (length (in-topicmaps top :revision 0)) 1))
- (is (eql tm (first (in-topicmaps top :revision 0)))))
- ((and
- (= (length (psis top :revision 0)) 1)
- (find
- (uri (first (psis top :revision 0)))
- (list
- "http://psi.topicmaps.org/tmcl/topic-type"
- "http://psi.topicmaps.org/tmcl/occurrence-type"
- "http://psi.topicmaps.org/tmcl/association-type"
- "http://psi.topicmaps.org/tmcl/name-type"
- "http://psi.topicmaps.org/tmcl/scope-type"
- "http://psi.topicmaps.org/tmcl/role-type")
- :test #'string=))
- (is-false (used-as-theme top :revision 0))
- (is-false (used-as-type top :revision 0))
- (is-true (player-in-roles top :revision 0))
- (is-false (reified-construct top :revision 0))
- (is-false (occurrences top :revision 0))
- (is-false (names top :revision 0))
- (is-false (item-identifiers top :revision 0))
- (is-false (locators top :revision 0))
- (is (= (length (in-topicmaps top :revision 0)) 1))
- (is (eql tm (first (in-topicmaps top :revision 0)))))
- ((or (and
- (= (length (psis top :revision 0)) 1)
- (find
- (uri (first (psis top :revision 0)))
- (list
- "http://some.where/tmsparql/author/goethe"
- "http://some.where/tmsparql/author"
- "http://some.where/psis/poem/zauberlehrling"
- "http://some.where/tmsparql/poem"
- "http://some.where/tmsparql/display-name"
- "http://some.where/tmsparql/de"
- "http://some.where/tmsparql/reifier-type")
- :test #'string=))
- (and
- (= (length (item-identifiers top :revision 0)) 1)
- (find
- (uri (first (item-identifiers top :revision 0)))
- (list
- "http://some.where/ii/goethe-occ-reifier"
- "http://some.where/ii/goethe-name-reifier"
- "http://some.where/ii/association-reifier"
- "http://some.where/ii/role-reifier")
- :test #'string=)))
- nil) ;is checked in the next unit-test
- (t
- (is-false top)))))))
+ (is-true topic-name)
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
+ (loop for top in (elephant:get-instances-by-class 'TopicC) do
+ (cond ((and
+ (= (length (psis top :revision 0)) 1)
+ (find
+ (uri (first (psis top :revision 0)))
+ (list
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#association"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#class"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
+ :test #'string=))
+ (is-false (used-as-theme top :revision 0))
+ (is-false (used-as-type top :revision 0))
+ (is-false (player-in-roles top :revision 0))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is (= (length (in-topicmaps top :revision 0)) 1))
+ (is (eql tm (first (in-topicmaps top :revision 0)))))
+ ((and
+ (= (length (psis top :revision 0)) 1)
+ (string= (uri (first (psis top :revision 0)))
+ "http://psi.topicmaps.org/iso13250/model/topic-name"))
+ (is-false (used-as-theme top :revision 0))
+ (is-true (used-as-type top :revision 0))
+ (is-false (player-in-roles top :revision 0))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is-false (in-topicmaps top :revision 0)))
+ ((and
+ (= (length (psis top :revision 0)) 1)
+ (find (uri (first (psis top :revision 0)))
+ (list "http://psi.topicmaps.org/iso13250/model/type-instance"
+ "http://psi.topicmaps.org/iso13250/model/type"
+ "http://psi.topicmaps.org/iso13250/model/instance")
+ :test #'string=))
+ (is-false (used-as-theme top :revision 0))
+ (is (= (length (used-as-type top :revision 0)) 29))
+ (is-false (player-in-roles top :revision 0))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is (= (length (in-topicmaps top :revision 0)) 1))
+ (is (eql tm (first (in-topicmaps top :revision 0)))))
+ ((and
+ (= (length (psis top :revision 0)) 1)
+ (find
+ (uri (first (psis top :revision 0)))
+ (list
+ "http://some.where/tmsparql/written-by"
+ "http://some.where/tmsparql/written"
+ "http://some.where/tmsparql/writer"
+ "http://some.where/tmsparql/first-name"
+ "http://some.where/tmsparql/last-name"
+ "http://some.where/tmsparql/title"
+ "http://some.where/tmsparql/date-of-birth"
+ "http://some.where/tmsparql/date-of-death"
+ "http://some.where/tmsparql/years"
+ "http://some.where/tmsparql/isDead"
+ "http://some.where/tmsparql/isAlive"
+ "http://some.where/tmsparql/poem-content")
+ :test 'string=))
+ (is-false (used-as-theme top :revision 0))
+ (is-true (used-as-type top :revision 0))
+ (is (= (length (player-in-roles top :revision 0)) 1))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is (= (length (in-topicmaps top :revision 0)) 1))
+ (is (eql tm (first (in-topicmaps top :revision 0)))))
+ ((and
+ (= (length (psis top :revision 0)) 1)
+ (find
+ (uri (first (psis top :revision 0)))
+ (list
+ "http://psi.topicmaps.org/tmcl/topic-type"
+ "http://psi.topicmaps.org/tmcl/occurrence-type"
+ "http://psi.topicmaps.org/tmcl/association-type"
+ "http://psi.topicmaps.org/tmcl/name-type"
+ "http://psi.topicmaps.org/tmcl/scope-type"
+ "http://psi.topicmaps.org/tmcl/role-type")
+ :test #'string=))
+ (is-false (used-as-theme top :revision 0))
+ (is-false (used-as-type top :revision 0))
+ (is-true (player-in-roles top :revision 0))
+ (is-false (reified-construct top :revision 0))
+ (is-false (occurrences top :revision 0))
+ (is-false (names top :revision 0))
+ (is-false (item-identifiers top :revision 0))
+ (is-false (locators top :revision 0))
+ (is (= (length (in-topicmaps top :revision 0)) 1))
+ (is (eql tm (first (in-topicmaps top :revision 0)))))
+ ((or (and
+ (= (length (psis top :revision 0)) 1)
+ (find
+ (uri (first (psis top :revision 0)))
+ (list
+ "http://some.where/tmsparql/author/goethe"
+ "http://some.where/tmsparql/author"
+ "http://some.where/psis/poem/zauberlehrling"
+ "http://some.where/tmsparql/poem"
+ "http://some.where/tmsparql/display-name"
+ "http://some.where/tmsparql/de"
+ "http://some.where/tmsparql/reifier-type")
+ :test #'string=))
+ (and
+ (= (length (item-identifiers top :revision 0)) 1)
+ (find
+ (uri (first (item-identifiers top :revision 0)))
+ (list
+ "http://some.where/ii/goethe-occ-reifier"
+ "http://some.where/ii/goethe-name-reifier"
+ "http://some.where/ii/association-reifier"
+ "http://some.where/ii/role-reifier")
+ :test #'string=)))
+ nil) ;is checked in the next unit-test
+ (t
+ (is-false top)))))))
(test test-import-topic-maps-4
@@ -2721,17 +2774,24 @@
(asdf:component-pathname
(asdf:find-component constants:*isidorus-system* "unit_tests"))
"jtm_1.0_test.jtm")))
+ (topic-name
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*))))
(tm (import-construct-from-jtm-string
jtm-str :revision 100 :jtm-format :1.0
:tm-id "http://some.where/jtm-tm")))
+ (is-true topic-name)
(is-true tm)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
(loop for top in (elephant:get-instances-by-class 'TopicC) do
(cond ((and
(= (length (psis top :revision 0)) 1)
(find
(uri (first (psis top :revision 0)))
(list
+ "http://psi.topicmaps.org/iso13250/model/topic-name"
"http://psi.topicmaps.org/iso13250/model/type-instance"
"http://psi.topicmaps.org/iso13250/model/type"
"http://psi.topicmaps.org/iso13250/model/instance"
@@ -2866,6 +2926,10 @@
(asdf:component-pathname
(asdf:find-component constants:*isidorus-system* "unit_tests"))
"jtm_1.1_test.jtm"))))
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*)))
(signals exceptions::JTM-error
(import-construct-from-jtm-string
jtm-str-1 :revision 100 :jtm-format :1.1))
@@ -2891,6 +2955,11 @@
:locators
(list (make-construct 'SubjectLocatorC
:uri "http://some.where/sl-1"))))
+ (type-2 (make-construct
+ 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*))))
(parent-1 (make-construct
'TopicC :start-revision 100
:psis
@@ -2921,7 +2990,7 @@
(is-false (set-exclusive-or (themes name-1 :revision 0) (list scope-1)))
(is-false (themes name-2 :revision 0))
(is (eql (instance-of name-1 :revision 0) type-1))
- (is-false (instance-of name-2 :revision 0))
+ (is (eql (instance-of name-2 :revision 0) type-2))
(is-false (set-exclusive-or
(map 'list #'d:charvalue (variants name-1 :revision 0))
(list "var-1" "var-2") :test #'string=))
@@ -2940,6 +3009,10 @@
(test test-import-from-jtm-1
"Tests the functionimport-from-jtm."
(with-fixture with-empty-db ("data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*)))
(jtm:import-from-jtm
(merge-pathnames
(asdf:component-pathname
@@ -2953,13 +3026,17 @@
(merge-pathnames
(asdf:component-pathname constants:*isidorus-system*)
"data_base"))
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))))
(test test-import-from-jtm-2
"Tests the functionimport-from-jtm."
(with-fixture with-empty-db ("data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri *topic-name-psi*)))
(jtm:import-from-jtm
(merge-pathnames
(asdf:component-pathname
@@ -2974,7 +3051,7 @@
(merge-pathnames
(asdf:component-pathname constants:*isidorus-system*)
"data_base"))
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 42))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))))
Modified: trunk/src/unit_tests/rdf_importer_test.lisp
==============================================================================
--- trunk/src/unit_tests/rdf_importer_test.lisp (original)
+++ trunk/src/unit_tests/rdf_importer_test.lisp Tue May 10 11:54:42 2011
@@ -1043,7 +1043,7 @@
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(rdf-importer::import-node node tm-id revision-2
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
(let ((first-node (get-item-by-id "http://test-tm/first-node"
:xtm-id document-id
:revision 0))
@@ -1264,7 +1264,7 @@
2))
(rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 41))
(is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12))
(setf rdf-importer::*current-xtm* document-id)
(is (= (length
@@ -1582,7 +1582,7 @@
(date "http://www.w3.org/2001/XMLSchema#date")
(de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope/de"))
(long "http://www.w3.org/2001/XMLSchema#unsignedLong"))
- (is (= (length topics) 65))
+ (is (= (length topics) 66))
(is (= (length occs) 23))
(is (= (length assocs) 30))
(is-true de)
@@ -2574,7 +2574,7 @@
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 22))
(is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1))
(is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
(is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
@@ -2637,7 +2637,7 @@
(rdf-init-db :db-dir db-dir :start-revision revision-1)
(rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id
:document-id document-id)
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29))
(is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6))
(is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0))
(is (= (length (elephant:get-instances-by-class 'd:NameC)) 0))
Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp (original)
+++ trunk/src/unit_tests/reification_test.lisp Tue May 10 11:54:42 2011
@@ -240,16 +240,20 @@
(test test-xtm1.0-reification
"Tests the reification in the xtm1.0-importer."
- (let
- ((dir "data_base"))
+ (let ((dir "data_base"))
(with-fixture initialize-destination-db (dir)
+ (base-tools:open-tm-store "data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri constants:*topic-name-psi*)))
(xtm-importer:import-from-xtm
*reification_xtm1.0.xtm* dir
:tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"
:xtm-id "reification-xtm"
:xtm-format :1.0)
(setf *TM-REVISION* 0)
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 12))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
(let ((homer
(identified-construct
@@ -301,20 +305,24 @@
t)
(condition () nil)))
(is-false (occurrences homer))
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 12))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13))
(close-tm-store))))))
(test test-xtm2.0-reification
"Tests the reification in the xtm2.0-importer."
- (let
- ((dir "data_base"))
+ (let ((dir "data_base"))
(with-fixture initialize-destination-db (dir)
+ (base-tools:open-tm-store "data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri constants:*topic-name-psi*)))
(xtm-importer:import-from-xtm
*reification_xtm2.0.xtm* dir
:tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"
:xtm-id "reification-xtm")
- (is (= (length (elephant:get-instances-by-class 'TopicC)) 12))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
(setf *TM-REVISION* 0)
(let ((homer
@@ -367,17 +375,21 @@
t)
(condition () nil)))
(is-false (occurrences homer))
- (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 12))
+ (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13))
(close-tm-store))))))
(test test-xtm1.0-reification-exporter
"Tests the reification in the xtm1.0-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.xtm")
- (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"))
+ (let ((dir "data_base")
+ (output-file "__out__.xtm")
+ (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"))
(with-fixture initialize-destination-db (dir)
+ (base-tools:open-tm-store "data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri constants:*topic-name-psi*)))
(handler-case (delete-file output-file)
(error () )) ;do nothing
(setf *TM-REVISION* 0)
@@ -466,11 +478,15 @@
(test test-xtm2.0-reification-exporter
"Tests the reification in the xtm2.0-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.xtm")
- (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"))
+ (let ((dir "data_base")
+ (output-file "__out__.xtm")
+ (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"))
(with-fixture initialize-destination-db (dir)
+ (base-tools:open-tm-store "data_base")
+ (make-construct 'TopicC :start-revision 100
+ :psis
+ (list (make-construct 'PersistentIdC
+ :uri constants:*topic-name-psi*)))
(handler-case (delete-file output-file)
(error () )) ;do nothing
(setf *TM-REVISION* 0)
@@ -752,10 +768,9 @@
(test test-rdf-exporter-reification
"Tests the reification in the rdf-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.rdf")
- (tm-id "http://simpsons.tv"))
+ (let ((dir "data_base")
+ (output-file "__out__.rdf")
+ (tm-id "http://simpsons.tv"))
(setf *TM-REVISION* 0)
(handler-case (delete-file output-file)
(error () )) ;do nothing
@@ -888,10 +903,9 @@
(test test-rdf-exporter-reification-3
"Tests the reification in the rdf-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.rdf")
- (tm-id "http://simpsons.tv"))
+ (let ((dir "data_base")
+ (output-file "__out__.rdf")
+ (tm-id "http://simpsons.tv"))
(setf *TM-REVISION* 0)
(handler-case (delete-file output-file)
(error () )) ;do nothing
@@ -923,10 +937,9 @@
(test test-rdf-exporter-reification-4
"Tests the reification in the rdf-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.rdf")
- (tm-id "http://simpsons.tv"))
+ (let ((dir "data_base")
+ (output-file "__out__.rdf")
+ (tm-id "http://simpsons.tv"))
(setf *TM-REVISION* 0)
(handler-case (delete-file output-file)
(error () )) ;do nothing
@@ -981,10 +994,9 @@
(test test-fragment-reification
"Tests the reification in the rdf-exporter."
- (let
- ((dir "data_base")
- (output-file "__out__.rdf")
- (tm-id "http://simpsons.tv"))
+ (let ((dir "data_base")
+ (output-file "__out__.rdf")
+ (tm-id "http://simpsons.tv"))
(setf *TM-REVISION* 0)
(handler-case (delete-file output-file)
(error () )) ;do nothing
@@ -1016,17 +1028,4 @@
(defun run-reification-tests ()
- (it.bese.fiveam:run! 'test-merge-reifier-topics)
- (it.bese.fiveam:run! 'test-xtm1.0-reification)
- (it.bese.fiveam:run! 'test-xtm2.0-reification)
- (it.bese.fiveam:run! 'test-xtm1.0-reification-exporter)
- (it.bese.fiveam:run! 'test-xtm2.0-reification-exporter)
- (it.bese.fiveam:run! 'test-rdf-importer-reification)
- (it.bese.fiveam:run! 'test-rdf-importer-reification-2)
- (it.bese.fiveam:run! 'test-rdf-importer-reification-3)
- (it.bese.fiveam:run! 'test-rdf-importer-reification-4)
- (it.bese.fiveam:run! 'test-rdf-exporter-reification)
- (it.bese.fiveam:run! 'test-rdf-exporter-reification-2)
- (it.bese.fiveam:run! 'test-rdf-exporter-reification-3)
- (it.bese.fiveam:run! 'test-rdf-exporter-reification-4)
- (it.bese.fiveam:run! 'test-fragment-reification))
\ No newline at end of file
+ (it.bese.fiveam:run! 'reification-test))
\ No newline at end of file
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Tue May 10 11:54:42 2011
@@ -2094,9 +2094,7 @@
(is-true (= (length r-1) 12))
(map 'list #'(lambda(item)
(cond ((string= (getf item :variable) "pred1")
- ;one name without a type so it is not listed
- ;as regular triple but as tms:topicProperty
- (is (= (length (getf item :result)) 17)))
+ (is (= (length (getf item :result)) 18)))
((string= (getf item :variable) "pred2")
(is (= (length (getf item :result)) 3))
(is-false (set-exclusive-or
@@ -2127,9 +2125,12 @@
(concat "<" *tms-scope* ">"))
:test #'string=)))
((string= (getf item :variable) "obj1")
- (is (= (length (getf item :result)) 17))
+ (is (= (length (getf item :result)) 18))
(is-true (find "Johann Wolfgang" (getf item :result)
:test #'tm-sparql::literal=))
+ (is-true (find "Johann Wolfgang von Goethe"
+ (getf item :result)
+ :test #'tm-sparql::literal=))
(is-true (find "von Goethe" (getf item :result)
:test #'tm-sparql::literal=))
(is-true (find t (getf item :result)
Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp (original)
+++ trunk/src/xml/rdf/exporter.lisp Tue May 10 11:54:42 2011
@@ -271,10 +271,16 @@
"Creates a set of properties. Everyone contains a reference to
a scope topic."
(declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct))
- (map 'list #'(lambda(x)
- (cxml:with-element "isi:scope"
- (make-topic-reference x)))
- (themes owner-construct)))
+ (let ((scopes
+ (if (typep owner-construct 'VariantC)
+ (set-difference (themes owner-construct)
+ (when-do name (parent owner-construct)
+ (themes name)))
+ (themes owner-construct))))
+ (map 'list #'(lambda(x)
+ (cxml:with-element "isi:scope"
+ (make-topic-reference x)))
+ scopes)))
(defun resourceX-to-rdf-elem (owner-construct)
Modified: trunk/src/xml/rdf/map_to_tm.lisp
==============================================================================
--- trunk/src/xml/rdf/map_to_tm.lisp (original)
+++ trunk/src/xml/rdf/map_to_tm.lisp Tue May 10 11:54:42 2011
@@ -281,8 +281,12 @@
*rdf2tm-subject*))
(value-type-topic
(get-item-by-psi *tm2rdf-value-property* :revision start-revision)))
- (let ((scopes (get-players-by-role-type
- scope-assocs start-revision *rdf2tm-object*))
+ (let ((scopes
+ (remove-duplicates
+ (append (get-players-by-role-type
+ scope-assocs start-revision *rdf2tm-object*)
+ (when name
+ (themes name)))))
(value-and-datatype
(let ((value-occ
(find-if #'(lambda(occ)
Modified: trunk/src/xml/xtm/exporter.lisp
==============================================================================
--- trunk/src/xml/xtm/exporter.lisp (original)
+++ trunk/src/xml/xtm/exporter.lisp Tue May 10 11:54:42 2011
@@ -49,7 +49,7 @@
(when ,tm
(to-reifier-elem ,tm ,revision)
(map 'list #'(lambda(x)
- (to-elem x ,revision))
+ (to-elem x ,revision))
(item-identifiers ,tm :revision ,revision)))
, at body)))
Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp
==============================================================================
--- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original)
+++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Tue May 10 11:54:42 2011
@@ -129,11 +129,15 @@
(declare (type (or integer nil) revision))
(cxml:with-element "t:variant"
(to-reifier-elem-xtm1.0 variant revision)
- (when (themes variant :revision revision)
- (cxml:with-element "t:parameters"
- (map 'list #'(lambda(x)
- (to-topicRef-elem-xtm1.0 x revision))
- (themes variant :revision revision))))
+ (let ((scopes
+ (set-difference (themes variant :revision revision)
+ (when-do name (instance-of variant :revision revision)
+ (themes name :revision revision)))))
+ (when scopes
+ (cxml:with-element "t:parameters"
+ (map 'list #'(lambda(x)
+ (to-topicRef-elem-xtm1.0 x revision))
+ scopes))))
(cxml:with-element "t:variantName"
(to-resourceX-elem-xtm1.0 variant revision))))
Modified: trunk/src/xml/xtm/exporter_xtm2.0.lisp
==============================================================================
--- trunk/src/xml/xtm/exporter_xtm2.0.lisp (original)
+++ trunk/src/xml/xtm/exporter_xtm2.0.lisp Tue May 10 11:54:42 2011
@@ -108,11 +108,15 @@
(map 'list #'(lambda(x)
(to-elem x revision))
(item-identifiers variant :revision revision))
- (when (themes variant :revision revision)
- (cxml:with-element "t:scope"
- (map 'list #'(lambda(x)
- (ref-to-elem x revision))
- (themes variant :revision revision))))
+ (let ((scopes
+ (set-difference (themes variant :revision revision)
+ (when-do name (instance-of variant :revision revision)
+ (themes name :revision revision)))))
+ (when scopes
+ (cxml:with-element "t:scope"
+ (map 'list #'(lambda(x)
+ (ref-to-elem x revision))
+ scopes))))
(to-resourceX-elem variant revision)))
More information about the Isidorus-cvs
mailing list