Author: lgiessmann Date: Mon May 9 10:39:34 2011 New Revision: 464 Log: JTM: added unit-tests for importing JTM-roles => fixed a bug in referencing role-parents 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 10:39:34 2011 @@ -144,13 +144,13 @@ (type (get-item :TYPE jtm-list)) (reifier (get-item :REIFIER jtm-list)) (player (get-item :PLAYER jtm-list)) - (parent-reference (get-item :PARENT jtm-list)) + (parent-references (get-item :PARENT jtm-list)) (local-parent (if parent - parent - (when parent-reference - (get-item-from-jtm-reference - parent-reference :revision revision :prefixes prefixes))))) + (list parent) + (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-role-from-jtm-list(): the JTM role ~a must have exactly one parent set in its members." jtm-list)))) (unless type @@ -166,7 +166,7 @@ type :revision revision :prefixes prefixes) :player (get-item-from-jtm-reference player :revision revision :prefixes prefixes) - :parent local-parent))) + :parent (first local-parent)))) (defun make-plist-of-jtm-role(jtm-list &key (revision *TM-REVISION*) 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 10:39:34 2011 @@ -43,7 +43,8 @@ :test-make-instance-of-association :test-import-topics :test-merge-topics - :test-import-associations)) + :test-import-associations + :test-import-roles)) (in-package :jtm-test) @@ -2200,9 +2201,97 @@ nil :revision 100))))) +(test test-import-roles + "Tests the function import-role-from-jtm-list." + (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-role-1 "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-3]\",\"[pref_1:ii-4]\"],\"type\":\"sl:[pref_1:sl-1]\",\"item_type\":\"role\",\"parent\":[\"ii:[pref_1:ii-2]\"],\"reifier\":\"sl:[pref_1:sl-2]\",\"player\":\"si:[pref_1:psi-1]\"}") + (jtm-role-2 "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":\"ii:http:\\/\\/some.where\\/ii-1\",\"item_type\":\"role\",\"reifier\":null,\"player\":\"sl:http:\\/\\/some.where\\/sl-1\"}") + (type-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-1")))) + (reifier-1 (make-construct + 'TopicC :start-revision 100 + :locators + (list (make-construct 'SubjectLocatorC + :uri "http://some.where/sl-2")))) + (parent-1 (make-construct + 'AssociationC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-2")))) + (player-1 (make-construct + 'TopicC :start-revision 100 + :psis + (list (make-construct 'PersistentIdC + :uri "http://some.where/psi-1")))) + (type-2 (make-construct + 'TopicC :start-revision 100 + :item-identifiers + (list (make-construct 'ItemIdentifierC + :uri "http://some.where/ii-1")))) + (player-2 type-1) + (role-1 (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-1) + nil :revision 100 :prefixes prefixes)) + (role-2 (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-2) + parent-1 :revision 100))) + (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'RoleC)) 2)) + (is (= (length (roles parent-1 :revision 0)) 2)) + (map 'list #'(lambda(role) + (is (eql (parent role :revision 0) parent-1))) + (elephant:get-instances-by-class 'RoleC)) + (is-true (find-if #'(lambda(role) + (and + (eql (instance-of role :revision 0) type-1) + (eql (player role :revision 0) player-1) + (eql (reifier role :revision 0) reifier-1) + (= (length (item-identifiers role :revision 0)) 2) + (or (string= + (uri (first (item-identifiers role :revision 0))) + "http://some.where/ii-3") + (string= + (uri (second (item-identifiers role :revision 0))) + "http://some.where/ii-3")) + (or (string= + (uri (first (item-identifiers role :revision 0))) + "http://some.where/ii-4") + (string= + (uri (second (item-identifiers role :revision 0))) + "http://some.where/ii-4")))) + (roles parent-1 :revision 0))) + (is-true (find-if #'(lambda(role) + (and + (eql (instance-of role :revision 0) type-2) + (eql (player role :revision 0) player-2) + (not (reifier role :revision 0)) + (not (item-identifiers role :revision 0)))) + (roles parent-1 :revision 0))) + (is-true (find role-1 (roles parent-1 :revision 0))) + (is-true (find role-2 (roles parent-1 :revision 0))) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-1) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string jtm-role-2) + nil :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":\"ii:http:\\/\\/some.where\\/ii-1\",\"item_type\":\"role\",\"reifier\":null,\"player\":null}") + parent-1 :revision 100)) + (signals exceptions::JTM-error + (jtm::import-role-from-jtm-list + (json:decode-json-from-string "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":null,\"item_type\":\"role\",\"reifier\":null,\"player\":\"ii:http:\\/\\/some.where\\/ii-1\"}") + parent-1 :revision 100))))) ;TODO: -; *import-role-from-jtm-list ; *import-construct-from-jtm-string ; *import-from-jtm ; *import-topic-map-from-jtm-list