[isidorus-cvs] r459 - in trunk/src: json/JTM unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon May 9 09:28:17 UTC 2011
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()
More information about the Isidorus-cvs
mailing list