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))) ,@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)))