[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