May 2011 - isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r460 - trunk/src/model
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 07:38:55 2011 New Revision: 460 Log: datamodel: fixed a bug when merging two associations, whereas each association owns a role that is equivalent to the other and both roles are reified by the same reifier-topic. Modified: trunk/src/model/datamodel.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Mon May 9 07:38:55 2011 @@ -2782,8 +2782,10 @@ (roles construct-1 :revision revision) (roles construct-2 :revision revision) :test #'(lambda(role-1 role-2) - (strictly-equivalent-constructs role-1 role-2 - :revision revision)))))) + ;(strictly-equivalent-constructs role-1 role-2 + ;:revision revision)))))) + (equivalent-constructs role-1 role-2 + :revision revision)))))) (defgeneric AssociationC-p (class-symbol)

1 0

[isidorus-cvs] r459 - in trunk/src: json/JTM unit_tests
by Lukas Giessmann 09 May '11

09 May '11

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()

1 0

[isidorus-cvs] r458 - trunk/src/unit_tests
by Lukas Giessmann 09 May '11

09 May '11

Author: lgiessmann Date: Mon May 9 03:59:00 2011 New Revision: 458 Log: JTM: added unit-tests fot the JTM-import of topic-stubs Modified: trunk/src/unit_tests/jtm_test.lisp 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 03:59:00 2011 @@ -40,7 +40,8 @@ :test-import-variants :test-import-occurrences :test-import-names - :test-make-instance-of-association)) + :test-make-instance-of-association + :test-import-topics)) (in-package :jtm-test) @@ -1553,8 +1554,8 @@ (test test-import-names - "Tests the functions import-name-from-jtm-string and - import-constructs-from-jtm-strings." + "Tests the functions import-name-from-jtm-list and + import-constructs-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*) @@ -1709,12 +1710,143 @@ tt (elephant:get-instance-by-value 'PersistentIdc 'd:uri *type-psi*) :revision 200) (signals exceptions:missing-reference-error - (jtm::make-instance-of-association top-1 top-3 (list tm) :revision 200)) - ))) + (jtm::make-instance-of-association top-1 top-3 (list tm) :revision 200))))) + + +(test test-import-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\":null,\"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\":[\"http:\\/\\/some.where\\/tmsparql\\/first-name\"],\"subject_locators\":null,\"item_identifiers\":null,\"names\":null,\"occurrences\":null}") + (j-top-5 "{\"subject_identifiers\":null,\"subject_locators\":null,\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/goethe-name-reifier\"],\"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"))))) + (is-false (elephant:get-instances-by-class 'd:TopicC)) + (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 2)) + (let ((top-1 (jtm::import-topic-stub-from-jtm-list + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 100 :prefixes prefixes))) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 1)) + (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)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 2)) + (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1)) + (is-false (set-exclusive-or (list "http://some.where/psi-1" + "http://some.where/psi-2") + (map 'list #'d:uri (psis top-1 :revision 0)) + :test #'string=)) + (is-false (set-exclusive-or + (list "http://some.where/sl-2") + (map 'list #'d:uri (locators top-1 :revision 0)) + :test #'string=)) + (is-false (set-exclusive-or + (list "http://some.where/ii-4") + (map 'list #'d:uri (item-identifiers top-1 :revision 0)) + :test #'string=)) + (is-true (find tm-1 (in-topicmaps top-1 :revision 0))) + (is-true (find tm-2 (in-topicmaps top-1 :revision 0)))) + (let ((top-2 (jtm::import-topic-stub-from-jtm-list + (json:decode-json-from-string j-top-2) + (list tm-1 tm-2) :revision 200))) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 1)) + (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)) + (is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 2)) + (is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3)) + (is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1)) + (is-false (set-exclusive-or (list "http://some.where/psi-1" + "http://some.where/psi-2") + (map 'list #'d:uri (psis top-2 :revision 200)) + :test #'string=)) + (is-false (set-exclusive-or + (list "http://some.where/sl-2") + (map 'list #'d:uri (locators top-2 :revision 200)) + :test #'string=)) + (is-false (set-exclusive-or + (list "http://some.where/ii-4") + (map 'list #'d:uri (item-identifiers top-2 :revision 200)) + :test #'string=)) + (is-true (find tm-1 (in-topicmaps top-2 :revision 200))) + (is-true (find tm-2 (in-topicmaps top-2 :revision 200)))) + (let ((tops-3-4-5 + (jtm::import-topic-stubs-from-jtm-lists + (list (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))) + (is (= (length tops-3-4-5) 3)) + (is (= (length (elephant:get-instances-by-class 'TopicC)) 4)) + (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)) 1)) + (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)) + (is-true (find-if #'(lambda(top) + (and (= (length (psis top :revision 0)) 1) + (not (item-identifiers top :revision 0)) + (not (locators top :revision 0)) + (string= (uri (first (psis top :revision 0))) + "http://some.where/tmsparql/author"))) + tops-3-4-5)) + (is-true + (find-if #'(lambda(top) + (and (= (length (psis top :revision 0)) 1) + (not (item-identifiers top :revision 0)) + (not (locators top :revision 0)) + (string= (uri (first (psis top :revision 0))) + "http://some.where/tmsparql/first-name"))) + tops-3-4-5)) + (is-true + (find-if #'(lambda(top) + (and (= (length (item-identifiers top :revision 0)) 1) + (not (psis top :revision 0)) + (not (locators top :revision 0)) + (string= (uri (first (item-identifiers top :revision 0))) + "http://some.where/ii/goethe-name-reifier"))) + tops-3-4-5)) + (signals exceptions:jtm-error + (jtm::import-topic-stub-from-jtm-list + (json:decode-json-from-string j-top-1) + (list tm-1 tm-2) :revision 200)) + (signals exceptions:missing-reference-error + (jtm::import-topic-stub-from-jtm-list + (json:decode-json-from-string j-top-2) + nil :revision 200)) + (signals exceptions:jtm-error + (jtm::import-topic-stubs-from-jtm-lists + (list (json:decode-json-from-string j-top-1)) + (list tm-1 tm-2) :revision 200)) + (signals exceptions:missing-reference-error + (jtm::import-topic-stubs-from-jtm-lists + (list (json:decode-json-from-string j-top-2)) + nil :revision 200)))))) + ;TODO: -; *import-topic-stubs-from-jtm-lists -; *import-topic-stub-from-jtm-list ; *merge-topics-from-jtm-lists ; *merge-topic-from-jtm-list

1 0

[isidorus-cvs] r457 - in trunk/src: json/JTM unit_tests xml/xtm
by Lukas Giessmann 08 May '11

08 May '11

Author: lgiessmann Date: Sun May 8 12:53:59 2011 New Revision: 457 Log: JTM: added a unit-test for the function make-instance-of-association => if a new instance-of-association is created, all topic-types are added to the parent-topicmaps Modified: trunk/src/json/JTM/jtm_importer.lisp trunk/src/unit_tests/jtm_test.lisp trunk/src/xml/xtm/importer.lisp Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Sun May 8 12:53:59 2011 @@ -77,9 +77,16 @@ (declare (TopicC instance-top type-top) (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")))) (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))) + (unless (and i-top t-top ti-top) + (let ((missing-topic (cond ((not t-top) *type-psi*) + ((not i-top) *instance-psi*) + (t *type-instance-psi*)))) + (error (make-condition 'missing-reference-error :message (format nil "From make-instance-of-association(): the core topics ~a, ~a, and ~a are necessary, but ~a cannot be found" *type-psi* *instance-psi* *type-instance-psi* missing-topic) :reference missing-topic)))) (let ((assoc (make-construct 'AssociationC :start-revision revision :instance-of ti-top :roles (list (list :start-revision revision @@ -89,6 +96,9 @@ :player type-top :instance-of t-top))))) (dolist (tm parents) + (add-to-tm tm i-top) + (add-to-tm tm t-top) + (add-to-tm tm ti-top) (add-to-tm tm assoc)) assoc))) Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Sun May 8 12:53:59 2011 @@ -39,7 +39,8 @@ :test-import-identifiers :test-import-variants :test-import-occurrences - :test-import-names)) + :test-import-names + :test-make-instance-of-association)) (in-package :jtm-test) @@ -1634,10 +1635,86 @@ #'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") + (let* ((tt (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *type-psi*)))) + (it (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *instance-psi*)))) + (tit (make-construct 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri *type-instance-psi*)))) + (top-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (top-2 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (top-3 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (tm (make-construct + 'TopicMapC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/tm-ii"))))) + (jtm::make-instance-of-association top-1 top-2 (list tm) :revision 100) + (is (= (length (player-in-roles top-1 :revision 0)) 1)) + (is (eql (instance-of (first (player-in-roles top-1 :revision 0)) :revision 0) + it)) + (let ((assoc (parent (first (player-in-roles top-1 :revision 0)) :revision 0))) + (is-true assoc) + (is (= (length (roles assoc :revision 0)) 2)) + (is (eql (instance-of assoc :revision 0) tit)) + (is-true (find tm (in-topicmaps assoc :revision 0))) + (is-true (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) tt) + (eql (player role :revision 0) top-2))) + (roles assoc :revision 0)))) + (is (= (length (player-in-roles top-2 :revision 0)) 1)) + (is-true (find tm (in-topicmaps tt :revision 0))) + (is-false (find tm (in-topicmaps tt :revision 50))) + (is-true (find tm (in-topicmaps it :revision 0))) + (is-true (find tm (in-topicmaps tit :revision 0))) + (jtm::make-instance-of-association top-2 top-3 (list tm) :revision 100) + (is (= (length (player-in-roles top-2 :revision 0)) 2)) + (is (= (length (player-in-roles top-3 :revision 0)) 1)) + (is (eql (instance-of (first (player-in-roles top-3 :revision 0)) :revision 0) + tt)) + (let ((assoc (parent (first (player-in-roles top-3 :revision 0)) :revision 0))) + (is-true assoc) + (is (= (length (roles assoc :revision 0)) 2)) + (is (eql (instance-of assoc :revision 0) tit)) + (is-true (find tm (in-topicmaps assoc :revision 0))) + (is-true (find-if #'(lambda(role) + (and (eql (instance-of role :revision 0) it) + (eql (player role :revision 0) top-2))) + (roles assoc :revision 0)))) + (signals exceptions:JTM-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*) + :revision 200) + (signals exceptions:missing-reference-error + (jtm::make-instance-of-association top-1 top-3 (list tm) :revision 200)) + ))) + ;TODO: ; *import-topic-stubs-from-jtm-lists ; *import-topic-stub-from-jtm-list -; *make-instance-of-association ; *merge-topics-from-jtm-lists ; *merge-topic-from-jtm-list Modified: trunk/src/xml/xtm/importer.lisp ============================================================================== --- trunk/src/xml/xtm/importer.lisp (original) +++ trunk/src/xml/xtm/importer.lisp Sun May 8 12:53:59 2011 @@ -130,6 +130,7 @@ (from-topic-elem-to-stub top-elem revision :xtm-id "core.xtm"))) (add-to-tm tm top))))))) + ;TODO: replace the two importers with this macro (defmacro importer-mac (get-topic-elems get-association-elems

1 0

[isidorus-cvs] r456 - in trunk/src: json/JTM unit_tests
by Lukas Giessmann 07 May '11

07 May '11

Author: lgiessmann Date: Sat May 7 18:02:56 2011 New Revision: 456 Log: JTM: added functions that allow the import of a single topicstub, topic an array of topicstubs and topics 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 Sat May 7 18:02:56 2011 @@ -21,6 +21,130 @@ (rest (find item-keyword jtm-list :key #'first))) +(defun import-topic-stubs-from-jtm-lists (jtm-lists parents &key + (revision *TM-REVISION*) prefixes) + "Creates and returns a list of topics. + Note only the topic identifiers are imported and set in this function, + entire topics are imported in merge-topics-from-jtm-lists." + (declare (List jtm-lists parents prefixes) + (Integer revision)) + (map 'list #'(lambda(jtm-list) + (import-topic-stub-from-jtm-list + jtm-list parents :revision revision :prefixes prefixes)) + jtm-lists)) + + +(defun import-topic-stub-from-jtm-list(jtm-list parents &key + (revision *TM-REVISION*) prefixes) + "Creates and returns a topic object from the passed jtm + list generated by json:decode-json-from-string. + Note this function only sets the topic's identifiers." + (declare (List jtm-list parents prefixes) + (Integer revision)) + (let* ((t-iis (import-identifiers-from-jtm-strings + (get-item :ITEM--IDENTIFIERS jtm-list) + :prefixes prefixes)) + (t-psis (import-identifiers-from-jtm-strings + (get-item :SUBJECT--IDENTIFIERS jtm-list) + :prefixes prefixes :identifier-type-symbol 'd:PersistentIdC)) + (t-sls (import-identifiers-from-jtm-strings + (get-item :SUBJECT--LOCATORS jtm-list) + :prefixes prefixes :identifier-type-symbol 'd:SubjectLocatorC)) + (parent-references (get-item :PARENT jtm-list)) + (local-parents + (if parents + parents + (when parent-references + (get-items-from-jtm-references + parent-references :revision revision :prefixes prefixes))))) + (unless local-parents + (error (make-condition 'JTM-error :message (format nil "From import-topic-from-jtm-string(): the JTM topic ~a must have at least one parent set in its members." jtm-list)))) + (unless (append t-iis t-sls t-psis) + (error (make-condition 'JTM-error :message (format nil "From import-topic-from-jtm-string(): the JTM topic ~a must have at least one identifier set in its members." jtm-list)))) + (let* ((top (make-construct 'TopicC :start-revision revision + :psis t-psis + :item-identifiers t-iis + :locators t-sls))) + (dolist (tm local-parents) + (add-to-tm tm top)) + top))) + + +(defun make-instance-of-association (instance-top type-top parents &key + (revision *TM-REVISION*)) + "Creates and returns a type-instance-association for the passed + instance and type topics." + (declare (TopicC instance-top type-top) + (List parents) + (Integer revision)) + (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))) + (let ((assoc (make-construct 'AssociationC :start-revision revision + :instance-of ti-top + :roles (list (list :start-revision revision + :player instance-top + :instance-of i-top) + (list :start-revision revision + :player type-top + :instance-of t-top))))) + (dolist (tm parents) + (add-to-tm tm assoc)) + assoc))) + + +(defun merge-topics-from-jtm-lists (jtm-lists parents &key (instance-of-p t) + (revision *TM-REVISION*) prefixes) + "Creates and returns a list of topics." + (declare (List jtm-lists parents prefixes) + (Boolean instance-of-p) + (Integer revision)) + (map 'list #'(lambda(jtm-list) + (merge-topic-from-jtm-list + jtm-list parents :revision revision :prefixes prefixes + :instance-of-p instance-of-p)) + jtm-lists)) + + +(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." + (declare (List jtm-list prefixes parents) + (Boolean instance-of-p) + (Integer revision)) + (let* ((ids (append (get-item :ITEM--IDENTIFIERS jtm-list) + (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))) + (instanceof (get-items-from-jtm-references + (get-item :INSTANCE--OF jtm-list) :revision revision + :prefixes prefixes)) + (top-names (import-characteristics-from-jtm-lists + (get-item :NAMES jtm-list) top + #'import-name-from-jtm-list :revision revision + :prefixes prefixes)) + (top-occs (import-characteristics-from-jtm-lists + (get-item :OCCURRENCES jtm-list) top + #'import-occurrence-from-jtm-list :revision revision + :prefixes prefixes))) + (unless ids + (error (make-condition 'JTM-error :message (format nil "From merge-topic-from-jtm-list(): the passed topic has to own at least one identifier: ~a" jtm-list)))) + (unless top + (error (make-condition 'JTM-error :message (format nil "From merge-topic-from-jtm-list(): cannot find a topic that matches the corresponding JTM-list: ~a" jtm-list)))) + (when (and (not instance-of-p) instanceof) + (error (make-condition 'JTM-error :message (format nil "From merge-topic-from-jtm-list(): the JTM-topic has an instance_of member set, but JTM version 1.0 does not allow an intance_of member within a topic object: ~a" jtm-list)))) + (dolist (type-top instanceof) + (make-instance-of-association top type-top parents :revision revision)) + (dolist (name top-names) + (add-name top name :revision revision)) + (dolist (occ top-occs) + (add-occurrence top occ :revision revision)) + top)) + + (defun import-name-from-jtm-list (jtm-list parent &key (revision *TM-REVISION*) prefixes) "Creates and returns a name object from the passed jtm @@ -59,9 +183,9 @@ :reifier (when reifier (get-item-from-jtm-reference reifier :revision revision :prefixes prefixes))))) - (import-constructs-from-jtm-lists name-variants name - #'import-variant-from-jtm-list - :revision revision :prefixes prefixes) + (import-characteristics-from-jtm-lists name-variants name + #'import-variant-from-jtm-list + :revision revision :prefixes prefixes) name))) @@ -105,8 +229,8 @@ reifier :revision revision :prefixes prefixes))))) -(defun import-constructs-from-jtm-lists(jtm-lists parent next-fun &key - (revision *TM-REVISION*) prefixes) +(defun import-characteristics-from-jtm-lists(jtm-lists parent next-fun &key + (revision *TM-REVISION*) prefixes) "Creates and returns a list of TM-Constructs returned by next-fun." (declare (List jtm-lists prefixes) (Integer revision) Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Sat May 7 18:02:56 2011 @@ -1634,6 +1634,14 @@ #'jtm::import-name-from-jtm-list :revision 100))))) +;TODO: +; *import-topic-stubs-from-jtm-lists +; *import-topic-stub-from-jtm-list +; *make-instance-of-association +; *merge-topics-from-jtm-lists +; *merge-topic-from-jtm-list + + (defun run-jtm-tests() "Runs all tests of this test-suite." (it.bese.fiveam:run! 'jtm-tests)) \ No newline at end of file

1 0

[isidorus-cvs] r455 - in trunk/src: json/JTM model unit_tests
by Lukas Giessmann 06 May '11

06 May '11

Author: lgiessmann Date: Fri May 6 19:02:35 2011 New Revision: 455 Log: JTM: added unit-tests for functions that are responsible for importing jtm-variants, jtm-names, and jtm-occurrences => fixed some bugs Modified: trunk/src/json/JTM/jtm_importer.lisp trunk/src/model/datamodel.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 Fri May 6 19:02:35 2011 @@ -32,7 +32,7 @@ (get-item :ITEM--IDENTIFIERS jtm-list) :prefixes prefixes)) (scope (get-item :SCOPE jtm-list)) - (type (get-item :SCOPE jtm-list)) + (type (get-item :TYPE jtm-list)) (value (get-item :VALUE jtm-list)) (name-variants (get-item :VARIANTS jtm-list)) (reifier (get-item :REIFIER jtm-list)) @@ -43,20 +43,19 @@ (when parent-references (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) - (unless local-parent - (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a parent set in its members." jtm-list)))) - (unless type - (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a type set in its members." jtm-list)))) + (when (/= (length local-parent) 1) + (error (make-condition 'JTM-error :message (format nil "From import-name-from-jtm-string(): the JTM name ~a must have exactly one parent set in its members." jtm-list)))) (let ((name (make-construct 'NameC :start-revision revision :item-identifiers iis - :value (if value value "") + :charvalue value :themes (get-items-from-jtm-references scope :revision revision :prefixes prefixes) - :instance-of (get-item-from-jtm-reference - type :revision revision :prefixes prefixes) - :parent local-parent + :instance-of (when type + (get-item-from-jtm-reference + type :revision revision :prefixes prefixes)) + :parent (first local-parent) :reifier (when reifier (get-item-from-jtm-reference reifier :revision revision :prefixes prefixes))))) @@ -72,13 +71,13 @@ list generated by json:decode-json-from-string." (declare (List jtm-list prefixes) (Integer revision) - (type (or Null OccurrenceC) parent)) + (type (or Null TopicC) parent)) (let* ((iis (import-identifiers-from-jtm-strings (get-item :ITEM--IDENTIFIERS jtm-list) :prefixes prefixes)) (datatype (get-item :DATATYPE jtm-list)) (scope (get-item :SCOPE jtm-list)) - (type (get-item :SCOPE jtm-list)) + (type (get-item :TYPE jtm-list)) (value (get-item :VALUE jtm-list)) (reifier (get-item :REIFIER jtm-list)) (parent-references (get-item :PARENT jtm-list)) @@ -88,19 +87,19 @@ (when parent-references (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) - (unless local-parent + (when (/= (length local-parent) 1) (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a parent set in its members." jtm-list)))) (unless type (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a type set in its members." jtm-list)))) (make-construct 'OccurrenceC :start-revision revision :item-identifiers iis :datatype (if datatype datatype *xml-string*) - :value (if value value "") + :charvalue value :themes (get-items-from-jtm-references scope :revision revision :prefixes prefixes) :instance-of (get-item-from-jtm-reference type :revision revision :prefixes prefixes) - :parent local-parent + :parent (first local-parent) :reifier (when reifier (get-item-from-jtm-reference reifier :revision revision :prefixes prefixes))))) @@ -111,7 +110,7 @@ "Creates and returns a list of TM-Constructs returned by next-fun." (declare (List jtm-lists prefixes) (Integer revision) - (type (or Null NameC) parent) + (type (or Null ReifiableConstructC) parent) (Function next-fun)) (map 'list #'(lambda(jtm-list) (apply next-fun (list jtm-list parent :revision revision @@ -140,22 +139,22 @@ (when parent-references (get-items-from-jtm-references parent-references :revision revision :prefixes prefixes))))) - (unless local-parent - (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-string(): the JTM variant ~a must have a parent set in its members." jtm-list)))) + (when (/= (length local-parent) 1) + (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-string(): 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*) - :value (if value value "") + :charvalue value :themes (get-items-from-jtm-references scope :revision revision :prefixes prefixes) - :parent local-parent + :parent (first local-parent) :reifier (when reifier (get-item-from-jtm-reference reifier :revision revision :prefixes prefixes))))) (defun import-identifiers-from-jtm-strings - (jtm-strings &key (identifier-type-symbol 'ItemIdentifeirC) prefixes) + (jtm-strings &key (identifier-type-symbol 'ItemIdentifierC) prefixes) "Creates and returns a list of identifiers specified by jtm-strings and identifier-type-symbol." (declare (List jtm-strings) @@ -163,11 +162,13 @@ (List prefixes)) (map 'list #'(lambda(jtm-string) (import-identifier-from-jtm-string - jtm-string identifier-type-symbol :prefixes prefixes)) + jtm-string :prefixes prefixes + :identifier-type-symbol identifier-type-symbol)) jtm-strings)) -(defun import-identifier-from-jtm-string(jtm-string identifier-type-symbol - &key prefixes) + +(defun import-identifier-from-jtm-string + (jtm-string &key (identifier-type-symbol 'ItemIdentifierC) prefixes) "Creates and returns an identifier of the type specified by identifier-type-symbol." (declare (String jtm-string) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri May 6 19:02:35 2011 @@ -2224,15 +2224,19 @@ :revision revision))))) ;no revision need to be checked, since the revision ;is implicitely checked by the function identified-construct - (if (and result - (let ((parent-elem - (when (or (typep result 'CharacteristicC) - (typep result 'RoleC)) - (parent result :revision revision)))) - (find-item-by-revision result revision parent-elem))) + (if result result (when error-if-nil (error (make-object-not-found-condition "No such item is bound to the given identifier uri.")))))) +;(if (and result +;(let ((parent-elem +;(when (or (typep result 'CharacteristicC) +;(typep result 'RoleC)) +;(parent result :revision revision)))) +;(find-item-by-revision result revision parent-elem))) +;result +;(when error-if-nil +;(error (make-object-not-found-condition "No such item is bound to the given identifier uri.")))))) (defun get-item-by-item-identifier (uri &key (revision *TM-REVISION*) Modified: trunk/src/unit_tests/jtm_test.lisp ============================================================================== --- trunk/src/unit_tests/jtm_test.lisp (original) +++ trunk/src/unit_tests/jtm_test.lisp Fri May 6 19:02:35 2011 @@ -34,7 +34,12 @@ :test-export-to-jtm-fragment :test-export-as-jtm :test-import-jtm-references-1 - :test-import-jtm-references-2)) + :test-import-jtm-references-2 + :test-get-item + :test-import-identifiers + :test-import-variants + :test-import-occurrences + :test-import-names)) (in-package :jtm-test) @@ -1298,17 +1303,335 @@ (is (eql (elt refs (+ idx 4)) assoc-1))))))) +(test test-get-item + "Tests the function get-item." + (let* ((jtm-variant "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"http://some.where/ii-1\",\"[pref_1:ii-2]\"],\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}") + (jtm-lst (json:decode-json-from-string jtm-variant))) + (is (string= (jtm::get-item :VERSION jtm-lst) "1.1")) + (is-false (set-exclusive-or (jtm::get-item :ITEM--IDENTIFIERS jtm-lst) + (list "http://some.where/ii-1" + "[pref_1:ii-2]") :test #'string=)) + (is (eql (first (first (jtm::get-item :PREFIXES jtm-lst))) :XSD)) + (is (string= (rest (first (jtm::get-item :PREFIXES jtm-lst))) + "http://www.w3.org/2001/XMLSchema#")) + (is (eql (first (second (jtm::get-item :PREFIXES jtm-lst))) :PREF--1)) + (is (string= (rest (second (jtm::get-item :PREFIXES jtm-lst))) + "http://some.where/")))) + + +(test test-import-identifiers + "Tests the functions import-identifier-from-jtm-string and + import-identifiers-from-jtm-strings." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes (list (list :pref "pref_1" :value "http://pref.org/") + (list :pref "pref_2" :value "http://pref.org#") + (list :pref "pref_3" :value "http://pref.org/app/"))) + (j-ii-1 "http://pref.org/ii-1") + (j-ii-2 "[pref_1:ii-2]") + (j-sl-1 "[pref_2:sl-1]") + (j-sl-2 "[pref_3:app_2/sl-2]") + (j-psi-1 "[pref_3:psi-1]") + (j-psi-2 "http://pref.org/psi-2") + (ii-1 (jtm::import-identifier-from-jtm-string j-ii-1 :prefixes prefixes)) + (sl-1 (jtm::import-identifier-from-jtm-string + j-sl-1 :prefixes prefixes :identifier-type-symbol 'SubjectLocatorC)) + (psi-1 (jtm::import-identifier-from-jtm-string + j-psi-1 :prefixes prefixes :identifier-type-symbol 'PersistentIdC)) + (psi-2 (jtm::import-identifier-from-jtm-string + j-psi-2 :prefixes prefixes :identifier-type-symbol 'PersistentIdC)) + (psis (jtm::import-identifiers-from-jtm-strings + (list j-psi-1 j-psi-2) :prefixes prefixes + :identifier-type-symbol 'PersistentIdC)) + (iis (jtm::import-identifiers-from-jtm-strings (list j-ii-1 j-ii-2) + :prefixes prefixes)) + (ii-2 (elephant:get-instance-by-value + 'd:ItemIdentifierC 'd:uri "http://pref.org/ii-2")) + (sls (jtm::import-identifiers-from-jtm-strings + (list j-sl-1 j-sl-2) :prefixes prefixes + :identifier-type-symbol 'SubjectLocatorC)) + (sl-2 (elephant:get-instance-by-value + 'd:SubjectLocatorC 'd:uri "http://pref.org/app/app_2/sl-2"))) + (signals exceptions:JTM-error + (jtm::import-identifier-from-jtm-string j-ii-2)) + (signals exceptions:duplicate-identifier-error + (jtm::import-identifier-from-jtm-string + j-ii-1 :identifier-type-symbol 'PersistentIdC)) + (signals exceptions:JTM-error + (jtm::import-identifiers-from-jtm-strings (list j-ii-2))) + (signals exceptions:duplicate-identifier-error + (jtm::import-identifiers-from-jtm-strings + (list j-ii-1) :identifier-type-symbol 'PersistentIdC)) + (is (eql (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri j-ii-1) + ii-1)) + (is (find ii-2 iis)) + (is (eql (elephant:get-instance-by-value + 'd:SubjectLocatorC 'd:uri "http://pref.org#sl-1") + sl-1)) + (is (find sl-2 sls)) + (is (eql (elephant:get-instance-by-value + 'd:PersistentIdC 'd:uri "http://pref.org/app/psi-1") + psi-1)) + (is (eql (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri j-psi-2) + psi-2)) + (is-false (set-exclusive-or psis (list psi-1 psi-2))) + (is-false (set-exclusive-or iis (list ii-1 ii-2))) + (is-false (set-exclusive-or sls (list sl-1 sl-2)))))) + + +(test test-import-variants + "Tests the functions import-variant-from-jtm-string and + import-constructs-from-jtm-strings." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) + (list :pref "pref_1" :value "http://some.where/"))) + (jtm-var-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string *xml-string*) ",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}")) + (jtm-var-2 (concat "{\"version\":\"1.0\",\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-3\"],\"datatype\":" (json:encode-json-to-string *xml-uri*) ",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"variant\",\"scope\":[\"sl:http:\\/\\/some.where\\/sl-1\"],\"reifier\":\"ii:http:\\/\\/some.where\\/ii-2\"}")) + (jtm-var-3 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string *xml-string*) ",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-10]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}")) + (name-1 (make-construct + 'NameC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (scope-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (var-1 (jtm::import-variant-from-jtm-list + (json:decode-json-from-string jtm-var-1) nil :revision 100 + :prefixes prefixes)) + (scope-2 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (reifier-2 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-2")))) + (var-2 (jtm::import-variant-from-jtm-list + (json:decode-json-from-string jtm-var-2) name-1 :revision 100 + :prefixes prefixes)) + (vars (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-var-1) + (json:decode-json-from-string jtm-var-2)) name-1 + #'jtm::import-variant-from-jtm-list :revision 100 + :prefixes prefixes))) + (is-true (d:find-item-by-revision var-1 100 name-1)) + (is-false (d:find-item-by-revision var-1 50 name-1)) + (is (eql (parent var-1 :revision 0) name-1)) + (is (eql (parent var-2 :revision 0) name-1)) + (is (string= (datatype var-1) *xml-string*)) + (is (string= (datatype var-2) *xml-uri*)) + (is (string= (charvalue var-1) "var-1")) + (is (string= (charvalue var-2) "http://any.uri")) + (is-false (d:item-identifiers var-1 :revision 0)) + (is-false (set-exclusive-or + (map 'list #'d:uri (d:item-identifiers var-2 :revision 0)) + (list "http://some.where/ii-3") :test #'string=)) + (is-false (reifier var-1 :revision 0)) + (is (eql (reifier var-2 :revision 0) reifier-2)) + (is-false (set-exclusive-or (themes var-1 :revision 0) (list scope-1))) + (is-false (set-exclusive-or (themes var-2 :revision 0) (list scope-2))) + (is-false (set-exclusive-or vars (list var-1 var-2))) + (signals exceptions:missing-reference-error + (jtm::import-variant-from-jtm-list + (json:decode-json-from-string jtm-var-3) nil :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-variant-from-jtm-list + (json:decode-json-from-string jtm-var-1) name-1 :revision 100)) + (signals exceptions:JTM-error + (jtm::import-variant-from-jtm-list + (json:decode-json-from-string jtm-var-2) nil :revision 100)) + (signals exceptions:missing-reference-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-var-3)) nil + #'jtm::import-variant-from-jtm-list :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-var-1)) name-1 + #'jtm::import-variant-from-jtm-list :revision 100)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-var-2)) nil + #'jtm::import-variant-from-jtm-list :revision 100))))) -;TODO: *get-item -; *import-identifier-from-jtm-string -; *import-identifiers-from-jtm-strings -; *import-variant-from-jtm-list -; *import-variants-from-jtm-lists -; *import-occurrence-from-jtm-list -; *import-occurrences-from-jtm-lists -; *import-name-from-jtm-list -; *import-names-from-jtm-lists +(test test-import-occurrences + "Tests the functions import-occurrence-from-jtm-string and + import-constructs-from-jtm-strings." + (with-fixture with-empty-db ("data_base") + (let* ((prefixes (list (list :pref "xsd" :value *xsd-ns*) + (list :pref "pref_1" :value "http://some.where/"))) + (jtm-occ-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-2]\"],\"datatype\":" (json:encode-json-to-string *xml-string* ) ",\"type\":\"sl:[pref_1:sl-1]\",\"value\":\"occ-1\",\"item_type\":\"occurrence\",\"parent\":[\"si:[pref_1:psi-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":\"ii:[pref_1:ii-1]\"}")) + (jtm-occ-2 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string *xml-uri* ) ",\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}")) + (jtm-occ-3 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-2]\"],\"datatype\":" (json:encode-json-to-string *xml-string* ) ",\"type\":\"sl:[pref_1:sl-1]\",\"value\":\"occ-1\",\"item_type\":\"occurrence\",\"parent\":[\"si:[pref_1:psi-6]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":\"ii:[pref_1:ii-1]\"}")) + (jtm-occ-4 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string *xml-uri* ) ",\"type\":null,\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}")) + (jtm-occ-5 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string *xml-uri* ) ",\"type\":\"si:http://any-uri/psi-10\",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}")) + (type-1 (make-construct + 'TopicC :start-revision 0 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (scope-1 (make-construct + 'TopicC :start-revision 0 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (reifier-1 (make-construct + 'TopicC :start-revision 0 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (parent-1 scope-1) + (type-2 scope-1) + (occ-1 (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-1) nil :revision 100 + :prefixes prefixes)) + (occ-2 (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-2) parent-1 :revision 100 + :prefixes prefixes)) + (occs (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-occ-1) + (json:decode-json-from-string jtm-occ-2)) parent-1 + #'jtm::import-occurrence-from-jtm-list :revision 100 + :prefixes prefixes))) + (is-true (d:find-item-by-revision occ-1 100 parent-1)) + (is-false (d:find-item-by-revision occ-1 50 parent-1)) + (is (eql (parent occ-1 :revision 0) parent-1)) + (is (eql (parent occ-2 :revision 0) parent-1)) + (is (string= (datatype occ-1) *xml-string*)) + (is (string= (datatype occ-2) *xml-uri*)) + (is (string= (charvalue occ-1) "occ-1")) + (is (string= (charvalue occ-2) "http://any.uri")) + (is-false (set-exclusive-or + (map 'list #'d:uri (d:item-identifiers occ-1 :revision 0)) + (list "http://some.where/ii-2") :test #'string=)) + (is-false (d:item-identifiers occ-2 :revision 0)) + (is (eql (reifier occ-1 :revision 0) reifier-1)) + (is-false (reifier occ-2 :revision 0)) + (is-false (set-exclusive-or (themes occ-1 :revision 0) (list scope-1))) + (is-false (themes occ-2 :revision 0)) + (is (eql (instance-of occ-1 :revision 0) type-1)) + (is (eql (instance-of occ-2 :revision 0) type-2)) + (is-false (set-exclusive-or (list occ-1 occ-2) occs)) + (signals exceptions:missing-reference-error + (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-5) parent-1 :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-4) parent-1 :revision 100 + :prefixes prefixes)) + (signals exceptions:missing-reference-error + (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-3) nil :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-1) parent-1 :revision 100)) + (signals exceptions:JTM-error + (jtm::import-occurrence-from-jtm-list + (json:decode-json-from-string jtm-occ-2) nil :revision 100)) + (signals exceptions:missing-reference-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-occ-3)) nil + #'jtm::import-occurrence-from-jtm-list :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-occ-1)) parent-1 + #'jtm::import-occurrence-from-jtm-list :revision 100)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-occ-2)) nil + #'jtm::import-occurrence-from-jtm-list :revision 100))))) + + +(test test-import-names + "Tests the functions import-name-from-jtm-string and + import-constructs-from-jtm-strings." + (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/"))) + (jtm-name-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"pref_1\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_2\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_2:ii-2]\"],\"value\":\"name-1\",\"type\":\"sl:[pref_2:sl-1]\",\"item_type\":\"name\",\"parent\":[\"si:[pref_2:psi-1]\"],\"scope\":[\"si:[pref_2:psi-1]\"],\"variants\":[{\"item_identifiers\":null,\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-1\",\"scope\":[\"sl:[pref_2:sl-1]\"],\"reifier\":null},{\"item_identifiers\":null,\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-2\",\"scope\":[\"sl:[pref_2:sl-1]\"],\"reifier\":null}],\"reifier\":\"ii:[pref_2:ii-1]\"}")) + (jtm-name-2 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"scope\":null,\"variants\":null,\"reifier\":null}") + (jtm-name-3 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"parent\":[\"si:[pref_2:psi-10]\"],\"scope\":null,\"variants\":null,\"reifier\":null}") + (type-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (parent-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (scope-1 parent-1) + (reifier-1 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (name-1 (jtm::import-name-from-jtm-list + (json:decode-json-from-string jtm-name-1) nil :revision 100 + :prefixes prefixes)) + (name-2 (jtm::import-name-from-jtm-list + (json:decode-json-from-string jtm-name-2) parent-1 :revision 100 + :prefixes prefixes)) + (names (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-name-1) + (json:decode-json-from-string jtm-name-2)) parent-1 + #'jtm::import-name-from-jtm-list :revision 100 + :prefixes prefixes))) + (is-true (d:find-item-by-revision name-1 100 parent-1)) + (is-false (d:find-item-by-revision name-1 50 parent-1)) + (is (eql (parent name-1 :revision 0) parent-1)) + (is (eql (parent name-2 :revision 0) parent-1)) + (is (string= (charvalue name-1) "name-1")) + (is (string= (charvalue name-2) "name-2")) + (is-false (set-exclusive-or + (map 'list #'d:uri (d:item-identifiers name-1 :revision 0)) + (list "http://some.where/ii-2") :test #'string=)) + (is-false (d:item-identifiers name-2 :revision 0)) + (is (eql (reifier name-1 :revision 0) reifier-1)) + (is-false (reifier name-2 :revision 0)) + (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-false (set-exclusive-or + (map 'list #'d:charvalue (variants name-1 :revision 0)) + (list "var-1" "var-2") :test #'string=)) + (is-false (variants name-2 :revision 0)) + (is-false (set-exclusive-or names (list name-1 name-2))) + (signals exceptions:missing-reference-error + (jtm::import-name-from-jtm-list + (json:decode-json-from-string jtm-name-3) nil :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-name-from-jtm-list + (json:decode-json-from-string jtm-name-1) parent-1 :revision 100)) + (signals exceptions:JTM-error + (jtm::import-name-from-jtm-list + (json:decode-json-from-string jtm-name-2) nil :revision 100)) + (signals exceptions:missing-reference-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-name-3)) nil + #'jtm::import-name-from-jtm-list :revision 100 + :prefixes prefixes)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-name-1)) parent-1 + #'jtm::import-name-from-jtm-list :revision 100)) + (signals exceptions:JTM-error + (jtm::import-constructs-from-jtm-lists + (list (json:decode-json-from-string jtm-name-2)) nil + #'jtm::import-name-from-jtm-list :revision 100))))) (defun run-jtm-tests()

1 0