Author: lgiessmann Date: Mon May 9 05:28:16 2011 New Revision: 459
Log: JTM: added unit-tests for the function merge-topic-from-jtm-list => fixed a bug when referencing the topic that has to be merged
Modified: trunk/src/json/JTM/jtm_importer.lisp trunk/src/unit_tests/jtm_test.lisp
Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Mon May 9 05:28:16 2011 @@ -78,7 +78,7 @@ (List parents) (Integer revision)) (unless parents - (error (make-condition 'JTM-error :message (format nil "From make-instance-of-association(): parents must contain at least one TopicMapC object, but is nil")))) + (error (make-condition 'missing-reference-error :message (format nil "From make-instance-of-association(): parents must contain at least one TopicMapC object, but is nil")))) (let ((t-top (get-item-by-psi *type-psi* :revision revision)) (i-top (get-item-by-psi *instance-psi* :revision revision)) (ti-top (get-item-by-psi *type-instance-psi* :revision revision))) @@ -119,7 +119,11 @@ (defun merge-topic-from-jtm-list(jtm-list parents &key (instance-of-p t) (revision *TM-REVISION*) prefixes) "Creates and returns a topic object from the passed jtm - list generated by json:decode-json-from-string." + list generated by json:decode-json-from-string. + Note that the merged topics are not added explicitly to the parent + topic maps, it is only needed for the instance-of-associations - + topics are added in the function import-topic-stubs-from-jtm-lists + to their topic map elements." (declare (List jtm-list prefixes parents) (Boolean instance-of-p) (Integer revision)) @@ -127,8 +131,9 @@ (get-item :SUBJECT--IDENTIFIERS jtm-list) (get-item :SUBJECT--LOCATORS jtm-list))) (top (when ids - (get-item-from-jtm-reference (first ids) :revision revision - :prefixes prefixes))) + (get-item-by-any-id + (compute-uri-from-jtm-identifier (first ids) prefixes) + :revision revision))) (instanceof (get-items-from-jtm-references (get-item :INSTANCE--OF jtm-list) :revision revision :prefixes prefixes))
Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Mon May 9 05:28:16 2011 @@ -41,7 +41,8 @@ :test-import-occurrences :test-import-names :test-make-instance-of-association - :test-import-topics)) + :test-import-topics + :test-merge-topics))
(in-package :jtm-test) @@ -1636,7 +1637,6 @@ #'jtm::import-name-from-jtm-list :revision 100)))))
- (test test-make-instance-of-association "Tests the function make-instance-of-association." (with-fixture with-empty-db ("data_base") @@ -1704,7 +1704,7 @@ (and (eql (instance-of role :revision 0) it) (eql (player role :revision 0) top-2))) (roles assoc :revision 0)))) - (signals exceptions:JTM-error + (signals exceptions:missing-reference-error (jtm::make-instance-of-association top-1 top-3 nil :revision 100)) (delete-psi tt (elephant:get-instance-by-value 'PersistentIdc 'd:uri *type-psi*) @@ -1846,9 +1846,188 @@ nil :revision 200))))))
-;TODO: -; *merge-topics-from-jtm-lists -; *merge-topic-from-jtm-list + +(test test-merge-topics + "Tests the functions import-topic-stub-from-jtm-list, + and import-topic-stubs-from-jtm-lists." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) + (list :pref "pref_1" :value *xsd-ns*) + (list :pref "pref_2" :value "http://some.where/"))) + (j-top-1 "{"version":"1.1","prefixes":{"pref_1":"http:\/\/www.w3.org\/2001\/XMLSchema#","xsd":"http:\/\/www.w3.org\/2001\/XMLSchema#","pref_2":"http:\/\/some.where\/"},"subject_identifiers":["[pref_2:psi-1]","[pref_2:psi-2]"],"subject_locators":["[pref_2:sl-2]"],"item_identifiers":["[pref_2:ii-4]"],"instance_of":["ii:[pref_2:ii-1]"],"item_type":"topic","names":[{"item_identifiers":null,"value":"name-1","type":null,"scope":null,"variants":null,"reifier":null},{"item_identifiers":null,"value":"name-2","type":null,"scope":["sl:[pref_2:sl-1]"],"variants":[{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","value":"var-1","scope":["ii:[pref_2:ii-1]"],"reifier":null}],"reifier":null}],"occurrences":[{"item_identifiers":["[pref_2:ii-2]"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","type":"sl:[pref_2:sl-1]","value":"occ-1","scope":["si:[pref_2:psi-1]"],"reifier":"ii:[pref_2:ii-1]"},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#anyURI","type":"si:[pref_2:psi-1]","value":"http:\/\/any.uri","scope":null,"reifier":null}]}") + (j-top-2 "{"version":"1.0","subject_identifiers":["http:\/\/some.where\/psi-1","http:\/\/some.where\/psi-2"],"subject_locators":["http:\/\/some.where\/sl-2"],"item_identifiers":["http:\/\/some.where\/ii-4"],"item_type":"topic","parent":["ii:http:\/\/some.where\/ii-3"],"names":[{"item_identifiers":null,"value":"name-1","type":null,"scope":null,"variants":null,"reifier":null},{"item_identifiers":null,"value":"name-2","type":null,"scope":["sl:http:\/\/some.where\/sl-1"],"variants":[{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","value":"var-1","scope":["ii:http:\/\/some.where\/ii-1"],"reifier":null}],"reifier":null}],"occurrences":[{"item_identifiers":["http:\/\/some.where\/ii-2"],"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#string","type":"sl:http:\/\/some.where\/sl-1","value":"occ-1","scope":["si:http:\/\/some.where\/psi-1"],"reifier":"ii:http:\/\/some.where\/ii-1"},{"item_identifiers":null,"datatype":"http:\/\/www.w3.org\/2001\/XMLSchema#anyURI","type":"si:http:\/\/some.where\/psi-1","value":"http:\/\/any.uri","scope":null,"reifier":null}]}") + (j-top-3 "{"subject_identifiers":["http:\/\/some.where\/tmsparql\/author"],"subject_locators":null,"item_identifiers":null,"names":null,"occurrences":null}") + (j-top-4 "{"subject_identifiers":null,"subject_locators":["http:\/\/some.where\/sl-1"],"item_identifiers":null,"names":null,"occurrences":null}") + (j-top-5 "{"subject_identifiers":null,"subject_locators":null,"item_identifiers":["http:\/\/some.where\/ii-1"],"names":null,"occurrences":null}") + (tm-1 (make-construct + 'TopicMapC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/tm-1")))) + (tm-2 (make-construct + 'TopicMapC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/tm-2")))) + (tops (jtm::import-topic-stubs-from-jtm-lists + (list (json:decode-json-from-string j-top-1) + (json:decode-json-from-string j-top-2) + (json:decode-json-from-string j-top-3) + (json:decode-json-from-string j-top-4) + (json:decode-json-from-string j-top-5)) + (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 'ItemIdentifierC)) 4)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) + (is-false (elephant:get-instances-by-class 'NameC)) + (is-false (elephant:get-instances-by-class 'VariantC)) + (is-false (elephant:get-instances-by-class 'RoleC)) + (is-false (elephant:get-instances-by-class 'AssociationC)) + (is-false (elephant:get-instances-by-class 'OccurrenceC)) + (signals exceptions:missing-reference-error ;missing topics for + (jtm::merge-topic-from-jtm-list ;type-instance-associations + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 100 :prefixes prefixes)) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *type-psi*))) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *instance-psi*))) + (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *type-instance-psi*))) + (let ((top-1 (jtm::merge-topic-from-jtm-list + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 100 :prefixes prefixes)) + (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 'ItemIdentifierC)) 5)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) + (is (= (length (elephant:get-instances-by-class 'NameC)) 2)) + (is (= (length (elephant:get-instances-by-class 'VariantC)) 1)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 2)) + (is (eql top-1 top-2)) + (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)) + (not (themes name :revision 0)) + (not (variants name :revision 0)) + (not (reifier name :revision 0)) + (not (item-identifiers name :revision 0)))) + (names top-1 :revision 0))) + (is-true + (find-if #'(lambda(name) + (and (string= (charvalue name) "name-2") + (not (instance-of name :revision 0)) + (= (length (themes name :revision 0)) 1) + (= (length (locators (first (themes name :revision 0)) + :revision 0)) 1) + (string= + (uri (first (locators (first (themes name :revision 0)) + :revision 0))) + "http://some.where/sl-1") + (= (length (variants name :revision 0)) 1) + (not (reifier name :revision 0)) + (not (item-identifiers name :revision 0)))) + (names top-1 :revision 0))) + (is-true + (find-if #'(lambda(occ) + (and (string= (charvalue occ) "occ-1") + (string= (datatype occ) *xml-string*) + (instance-of occ :revision 0) + (= (length (locators (instance-of occ :revision 0) + :revision 0)) 1) + (string= + (uri (first (locators (instance-of occ :revision 0) + :revision 0))) + "http://some.where/sl-1") + (= (length (themes occ :revision 0)) 1) + (= (length (psis (first (themes occ :revision 0)) + :revision 0)) 2) + (or (string= + (uri (first (psis (first (themes occ :revision 0)) + :revision 0))) + "http://some.where/psi-1") + (string= + (uri (second (psis (first (themes occ :revision 0)) + :revision 0))) + "http://some.where/psi-1")) + (reifier occ :revision 0) + (= (length (item-identifiers occ :revision 0)) 1) + (string= (uri (first (item-identifiers occ :revision 0))) + "http://some.where/ii-2"))) + (occurrences top-1 :revision 0))) + (is-true + (find-if #'(lambda(occ) + (and (string= (charvalue occ) "http://any.uri") + (string= (datatype occ) *xml-uri*) + (instance-of occ :revision 0) + (or (string= + (uri (first (psis (instance-of occ :revision 0) + :revision 0))) + "http://some.where/psi-1") + (string= + (uri (second (psis (instance-of occ :revision 0) + :revision 0))) + "http://some.where/psi-1")) + (not (themes occ :revision 0)) + (not (reifier occ :revision 0)) + (not (item-identifiers occ :revision 0)))) + (occurrences top-1 :revision 0)))) + (let ((tops (jtm::merge-topics-from-jtm-lists + (list (json:decode-json-from-string j-top-1) + (json:decode-json-from-string j-top-2) + (json:decode-json-from-string j-top-3) + (json:decode-json-from-string j-top-4) + (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 'ItemIdentifierC)) 5)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2)) + (is (= (length (elephant:get-instances-by-class 'NameC)) 2)) + (is (= (length (elephant:get-instances-by-class 'VariantC)) 1)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 2))) + (signals exceptions:jtm-error + (jtm::merge-topic-from-jtm-list + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 200)) + (signals exceptions:jtm-error + (jtm::merge-topic-from-jtm-list + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil)) + (signals exceptions:missing-reference-error + (jtm::merge-topic-from-jtm-list + (json:decode-json-from-string j-top-1) + nil :revision 200 :prefixes prefixes)) + (signals exceptions:jtm-error + (jtm::merge-topics-from-jtm-lists + (list (json:decode-json-from-string j-top-1)) + (list tm-1 tm-2) :revision 200)) + (signals exceptions:jtm-error + (jtm::merge-topics-from-jtm-lists + (list (json:decode-json-from-string j-top-1)) + (list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil)) + (signals exceptions:missing-reference-error + (jtm::merge-topics-from-jtm-lists + (list (json:decode-json-from-string j-top-1)) + nil :revision 200 :prefixes prefixes)))))
(defun run-jtm-tests()