[isidorus-cvs] r466 - trunk/src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue May 10 09:47:25 UTC 2011
Author: lgiessmann
Date: Tue May 10 05:47:25 2011
New Revision: 466
Log:
JTM: added a unit-tests that test the function import-construct-from-jtm-string
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 Tue May 10 05:47:25 2011
@@ -49,7 +49,8 @@
:test-import-topic-maps-2
:test-import-topic-maps-3
:test-import-topic-maps-4
- :test-import-topic-maps-5))
+ :test-import-topic-maps-5
+ :test-import-construct-from-jtm-string))
(in-package :jtm-test)
@@ -2874,6 +2875,63 @@
(map 'list #'uri (item-identifiers tm :revision 0))
:test #'string=))
(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))))))
+
+
+(test test-import-construct-from-jtm-string
+ "Tests the function import-construct-from-jtm-string when importing a name."
+ (with-fixture with-empty-db ("data_base")
+ (let* ((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\",\"parent\":[\"sl:http://some.where/sl-1\"],\"scope\":null,\"variants\":null,\"reifier\":null}")
+ (jtm-name-3 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"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-construct-from-jtm-string
+ jtm-name-1 :revision 100 :jtm-format :1.1))
+ (name-2 (jtm::import-construct-from-jtm-string
+ jtm-name-2 :revision 100 :jtm-format :1.0)))
+ (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) type-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))
+ (signals exceptions:JTM-error
+ (jtm::import-construct-from-jtm-string
+ jtm-name-3 :revision 100 :jtm-format :1.0))
+ (signals exceptions:JTM-error
+ (jtm::import-construct-from-jtm-string
+ jtm-name-2 :revision 100 :jtm-format :1.1))
+ (signals exceptions:JTM-error
+ (jtm::import-construct-from-jtm-string
+ jtm-name-1 :revision 100 :jtm-format :1.0)))))
More information about the Isidorus-cvs
mailing list