[isidorus-cvs] r461 - in trunk/src: json/JTM unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Mon May 9 11:45:03 UTC 2011


Author: lgiessmann
Date: Mon May  9 07:45:02 2011
New Revision: 461

Log:
JTM: added the functions import-associaiton-from-jtm-list and import-associations-from-jtm-lists; added unit-tests for imporkting jtm-associations

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 07:45:02 2011
@@ -21,6 +21,86 @@
   (rest (find item-keyword jtm-list :key #'first)))
 
 
+(defun import-associations-from-jtm-lists (jtm-lists parents &key
+					   (revision *TM-REVISION*) prefixes)
+  "Create a listof AssociationC objects corresponding to the passed jtm-lists
+    and returns it."
+  (declare (List jtm-lists parents prefixes)
+	   (Integer revision))
+  (map 'list #'(lambda(jtm-list)
+		 (import-association-from-jtm-list
+		  jtm-list parents :revision revision :prefixes prefixes))
+       jtm-lists))
+
+
+(defun make-plist-of-jtm-role(jtm-list &key (revision *TM-REVISION*) prefixes)
+  "Returns a plist of the form (:start-revision <rev> :player <top>
+   :instance-of <top> :reifier <top> :item-identifiers <ii>)."
+  (unless (and (get-item :PLAYER jtm-list)
+	       (get-item :TYPE jtm-list))
+    (error (make-condition 'JTM-error :message (format nil "From make-plist-of-jtm-role(): the role ~a must have a type and player member set." jtm-list))))
+  (list :start-revision revision
+	:player (get-item-from-jtm-reference
+		 (get-item :PLAYER jtm-list)
+		 :revision revision :prefixes prefixes)
+	:instance-of (get-item-from-jtm-reference
+		      (get-item :TYPE jtm-list)
+		      :revision revision :prefixes prefixes)
+	:item-identifiers (import-identifiers-from-jtm-strings
+			   (get-item :ITEM--IDENTIFIERS jtm-list)
+			   :prefixes prefixes)
+	:reifier (when (get-item :REIFIER jtm-list)
+		   (get-item-from-jtm-reference
+		    (get-item :REIFIER jtm-list)
+		    :revision revision :prefixes prefixes))))
+
+
+(defun import-association-from-jtm-list (jtm-list parents &key
+					 (revision *TM-REVISION*) prefixes)
+  "Create an AssociationC object corresponding to the passed jtm-list and
+   returns it."
+  (declare (List jtm-list parents prefixes)
+	   (Integer revision))
+  (let* ((iis (import-identifiers-from-jtm-strings
+	       (get-item :ITEM--IDENTIFIERS jtm-list)
+	       :prefixes prefixes))
+	 (scope (get-item :SCOPE jtm-list))
+	 (type (get-item :TYPE jtm-list))
+	 (reifier (get-item :REIFIER jtm-list))
+	 (parent-references (get-item :PARENT jtm-list))
+	 (role-lists
+	  (map 'list #'(lambda(role)
+			 (make-plist-of-jtm-role role :revision revision
+						 :prefixes prefixes))
+	       (get-item :ROLES jtm-list)))
+	 (local-parent
+	  (if parents
+	      parents
+	      (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-association-from-jtm-list(): the JTM association ~a must have at least one parent set in its members." jtm-list))))
+    (unless role-lists
+      (error (make-condition 'JTM-error :message (format nil "From import-association-from-jtm-list(): the JTM association ~a must have at least one role set in its members." jtm-list))))
+    (unless type
+      (error (make-condition 'JTM-error :message (format nil "From import-association-from-jtm-list(): the association ~a must have exactly one type set as member." jtm-list))))
+    (let ((assoc
+	   (make-construct 'AssociationC :start-revision revision
+			   :item-identifiers iis
+			   :themes (get-items-from-jtm-references
+				    scope :revision revision :prefixes prefixes)
+			   :reifier (when reifier
+				      (get-item-from-jtm-reference
+				       reifier :revision revision :prefixes prefixes))
+			   :instance-of (get-item-from-jtm-reference
+					 type :revision revision :prefixes prefixes)
+			   :roles role-lists)))
+      (dolist (tm local-parent)
+	(add-to-tm tm assoc))
+      assoc)))
+
+
 (defun import-topic-stubs-from-jtm-lists (jtm-lists parents &key
 					  (revision *TM-REVISION*) prefixes)
   "Creates and returns a list of topics.
@@ -78,7 +158,7 @@
 	   (List parents)
 	   (Integer revision))
   (unless parents
-    (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"))))
+    (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)))
@@ -87,14 +167,15 @@
 				 ((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
-						    :player instance-top
-						    :instance-of i-top)
-					      (list :start-revision revision
-						    :player type-top
-						    :instance-of t-top)))))
+    (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 i-top)
 	(add-to-tm tm t-top)
@@ -183,7 +264,7 @@
 		(get-items-from-jtm-references
 		 parent-references :revision revision :prefixes prefixes)))))
     (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))))
+      (error (make-condition 'JTM-error :message (format nil "From import-name-from-jtm-list(): the JTM name ~a must have exactly one parent set in its members." jtm-list))))
     (let ((name
 	   (make-construct
 	    'NameC :start-revision revision
@@ -227,9 +308,9 @@
 		(get-items-from-jtm-references
 		 parent-references :revision revision :prefixes prefixes)))))
     (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))))
+      (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-list(): 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))))
+      (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-list(): 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*)
@@ -279,7 +360,7 @@
 		(get-items-from-jtm-references
 		 parent-references :revision revision :prefixes prefixes)))))
     (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))))
+      (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-list(): 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*)

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 07:45:02 2011
@@ -42,7 +42,8 @@
 	   :test-import-names
 	   :test-make-instance-of-association
 	   :test-import-topics
-	   :test-merge-topics))
+	   :test-merge-topics
+	   :test-import-associations))
 
 
 (in-package :jtm-test)
@@ -1383,7 +1384,7 @@
 
 (test test-import-variants
   "Tests the functions import-variant-from-jtm-string and
-   import-constructs-from-jtm-strings."
+   import-characteristics-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/")))
@@ -1416,7 +1417,7 @@
 	   (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
+	   (vars (jtm::import-characteristics-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
@@ -1449,23 +1450,23 @@
 	(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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-from-jtm-lists
 	 (list (json:decode-json-from-string jtm-var-2)) nil
 	 #'jtm::import-variant-from-jtm-list :revision 100)))))
 
 
 (test test-import-occurrences
   "Tests the functions import-occurrence-from-jtm-string and
-   import-constructs-from-jtm-strings."
+   import-characteristics-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/")))
@@ -1497,7 +1498,7 @@
 	   (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
+	   (occs (jtm::import-characteristics-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
@@ -1540,23 +1541,23 @@
 	(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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-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-list and
-   import-constructs-from-jtm-lists."
+   import-characteristics-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*)
@@ -1586,7 +1587,7 @@
 	   (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
+	   (names (jtm::import-characteristics-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
@@ -1623,16 +1624,16 @@
 	(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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-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
+	(jtm::import-characteristics-from-jtm-lists
 	 (list (json:decode-json-from-string jtm-name-2)) nil
 	 #'jtm::import-name-from-jtm-list :revision 100)))))
 
@@ -1704,7 +1705,7 @@
 			      (and (eql (instance-of role :revision 0) it)
 				   (eql (player role :revision 0) top-2)))
 			  (roles assoc :revision 0))))
-      (signals exceptions:missing-reference-error
+      (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*)
@@ -1846,7 +1847,6 @@
 	   nil :revision 200))))))
 
 
-
 (test test-merge-topics
   "Tests the functions import-topic-stub-from-jtm-list,
    and import-topic-stubs-from-jtm-lists."
@@ -2012,7 +2012,7 @@
 	(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
+      (signals exceptions:JTM-error
 	(jtm::merge-topic-from-jtm-list
 	 (json:decode-json-from-string j-top-1)
 	 nil :revision 200 :prefixes prefixes))
@@ -2024,12 +2024,193 @@
 	(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
+      (signals exceptions:JTM-error
 	(jtm::merge-topics-from-jtm-lists
 	 (list (json:decode-json-from-string j-top-1))
 	 nil :revision 200 :prefixes prefixes)))))
 
 
+(test test-import-associations
+  "Tests the functions import-association-from-jtm-list."
+  (with-fixture with-empty-db ("data_base")
+    (let* ((prefixes
+	    (list (list :pref "pref_3"
+			:value "http://psi.topicmaps.org/iso13250/model/")
+		  (list :pref "xsd" :value *xsd-ns*)
+		  (list :pref "pref_1" :value *xsd-ns*)
+		  (list :pref "pref_2" :value "http://some.where/")))
+	   (j-assoc-1 "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/association\"],\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written-by\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/association-reifier\",\"scope\":null,\"roles\":[{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/writer\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/role-reifier\",\"player\":\"si:http:\\/\\/some.where\\/tmsparql\\/author\\/goethe\"},{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/role-2\"],\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written\",\"reifier\":null,\"player\":\"si:http:\\/\\/some.where\\/psis\\/poem\\/zauberlehrling\"}]}")
+	   (j-assoc-2 "{\"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\":null,\"type\":\"si:[pref_3:type-instance]\",\"reifier\":null,\"scope\":[\"si:[pref_2:my-scope]\"],\"roles\":[{\"item_identifiers\":null,\"type\":\"si:[pref_3:type]\",\"reifier\":null,\"player\":\"si:[pref_2:tmsparql\\/author]\"},{\"item_identifiers\":null,\"type\":\"si:[pref_3:instance]\",\"reifier\":null,\"player\":\"si:[pref_2:tmsparql\\/author\\/goethe]\"}]}")
+	   (goethe (make-construct
+		    'TopicC :start-revision 100
+		    :psis
+		    (list (make-construct
+			   'PersistentIdC
+			   :uri "http://some.where/tmsparql/author/goethe"))))
+	   (zauberlehrling (make-construct
+			    'TopicC :start-revision 100
+			    :psis
+			    (list (make-construct
+				   'PersistentIdC
+				   :uri "http://some.where/psis/poem/zauberlehrling"))))
+	   (author (make-construct
+		    'TopicC :start-revision 100
+		    :psis
+		    (list (make-construct
+			   'PersistentIdC
+			   :uri "http://some.where/tmsparql/author"))))
+	   (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*))))
+	   (written-by (make-construct
+			'TopicC :start-revision 100
+			:psis
+			(list (make-construct
+			       'PersistentIdC
+			       :uri "http://some.where/tmsparql/written-by"))))
+	   (writer (make-construct
+		    'TopicC :start-revision 100
+		    :psis
+		    (list (make-construct
+			   'PersistentIdC
+			   :uri "http://some.where/tmsparql/writer"))))
+	   (written (make-construct
+		     'TopicC :start-revision 100
+		     :psis
+		     (list (make-construct
+			    'PersistentIdC
+			    :uri "http://some.where/tmsparql/written"))))
+	   (reifier-assoc-1 (make-construct
+			     'TopicC :start-revision 100
+			     :item-identifiers
+			     (list (make-construct
+				    'ItemIdentifierC
+				    :uri "http://some.where/ii/association-reifier"))))
+	   (reifier-role-1-1 (make-construct
+			     'TopicC :start-revision 100
+			     :item-identifiers
+			     (list (make-construct
+				    'ItemIdentifierC
+				    :uri "http://some.where/ii/role-reifier"))))
+	   (scope-2 (make-construct
+		     'TopicC :start-revision 100
+		     :psis
+		     (list (make-construct
+			    'PersistentIdC
+			    :uri "http://some.where/my-scope"))))
+	   (tm (make-construct 'TopicMapC :start-revision 100
+			       :item-idenitfiers
+			       (list (make-construct 'ItemIdentifierC
+						     :uri "http://some.where/tm")))))
+      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
+      (let ((assoc-1 (jtm::import-association-from-jtm-list 
+		      (json:decode-json-from-string j-assoc-1)
+		      (list tm) :revision 100)))
+	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+	(is (= (length (elephant:get-instances-by-class 'RoleC)) 2))
+	(is (eql (instance-of assoc-1 :revision 0) written-by))
+	(is-false (set-exclusive-or
+		   (list "http://some.where/ii/association")
+		   (map 'list #'d:uri (item-identifiers assoc-1 :revision 0))
+		   :test #'string=))
+	(is (eql (reifier assoc-1 :revision 0) reifier-assoc-1))
+	(is-true (find tm (in-topicmaps assoc-1 :revision 0)))
+	(is-false (themes assoc-1 :revision 0))
+	(= (length (roles assoc-1 :revision 0)) 2)
+	(is-true (find-if #'(lambda(role)
+			      (and (eql (instance-of role :revision 0) writer)
+				   (eql (player role :revision 0) goethe)
+				   (not (item-identifiers role :revision 0))
+				   (eql (reifier role :revision 0)
+					reifier-role-1-1)))
+			  (roles assoc-1 :revision 0)))
+	(is-true
+	 (find-if #'(lambda(role)
+		      (and (eql (instance-of role :revision 0) written)
+			   (eql (player role :revision 0) zauberlehrling)
+			   (= (length (item-identifiers role :revision 0)) 1)
+			   (string=
+			    "http://some.where/ii/role-2"
+			    (uri (first (item-identifiers role :revision 0))))
+			   (not (reifier role :revision 0))))
+		  (roles assoc-1 :revision 0)))
+	(is (= (length (player-in-roles goethe :revision 0)) 1))
+	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
+	(is (= (length (player-in-roles author :revision 0)) 0)))
+      (let ((assoc-2 (jtm::import-association-from-jtm-list 
+		      (json:decode-json-from-string j-assoc-2)
+		      (list tm) :revision 100 :prefixes prefixes)))
+	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 2))
+	(is (= (length (elephant:get-instances-by-class 'RoleC)) 4))
+	(is (eql (instance-of assoc-2 :revision 0) tit))
+	(is-false (item-identifiers assoc-2 :revision 0))
+	(is-false (reifier assoc-2 :revision 0))
+	(is-true (find tm (in-topicmaps assoc-2 :revision 0)))
+	(is (= (length (themes assoc-2 :revision 0)) 1))
+	(is (eql (first (themes assoc-2 :revision 0)) scope-2))
+	(= (length (roles assoc-2 :revision 0)) 2)
+	(is-true (find-if #'(lambda(role)
+			      (and (eql (instance-of role :revision 0) tt)
+				   (eql (player role :revision 0) author)
+				   (not (item-identifiers role :revision 0))
+				   (not (reifier role :revision 0))))
+			  (roles assoc-2 :revision 0)))
+	(is-true
+	 (find-if #'(lambda(role)
+		      (and (eql (instance-of role :revision 0) it)
+			   (eql (player role :revision 0) goethe)
+			   (not (item-identifiers role :revision 0))
+			   (not (reifier role :revision 0))))
+		  (roles assoc-2 :revision 0)))
+	(is (= (length (player-in-roles goethe :revision 0)) 2))
+	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
+	(is (= (length (player-in-roles author :revision 0)) 1)))
+      (let ((assocs (jtm::import-associations-from-jtm-lists
+		     (list (json:decode-json-from-string j-assoc-1)
+			   (json:decode-json-from-string j-assoc-2))
+		     (list tm) :revision 200 :prefixes prefixes)))
+	(is (= (length assocs) 2))
+	(is (= (length (player-in-roles goethe :revision 0)) 2))
+	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
+	(is (= (length (player-in-roles author :revision 0)) 1)))
+      (signals exceptions::JTM-error
+	(jtm::import-association-from-jtm-list 
+	 (json:decode-json-from-string j-assoc-1)
+	 nil :revision 100))
+      (signals exceptions::JTM-error
+	(jtm::import-association-from-jtm-list 
+	 (json:decode-json-from-string j-assoc-2)
+	 nil :revision 100))
+      (signals exceptions::JTM-error
+	(jtm::import-association-from-jtm-list 
+	 (json:decode-json-from-string 
+	  "{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written-by\",\"reifier\":null,\"scope\":null,\"roles\":null}")
+	 (list tm) :revision 100))
+      (signals exceptions::JTM-error
+	(jtm::import-association-from-jtm-list 
+	 (json:decode-json-from-string 
+	  "{\"item_identifiers\":null,\"type\":null,\"reifier\":null,\"scope\":null,\"roles\":[{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/writer\",\"reifier\":\"ii:http:\\/\\/some.where\\/ii\\/role-reifier\",\"player\":\"si:http:\\/\\/some.where\\/tmsparql\\/author\\/goethe\"}]}")
+	 (list tm) :revision 100))
+      (signals exceptions::JTM-error
+	(jtm::import-associations-from-jtm-lists 
+	 (list (json:decode-json-from-string j-assoc-1))
+	 nil :revision 100))
+      (signals exceptions::JTM-error
+	(jtm::import-associations-from-jtm-lists 
+	 (list (json:decode-json-from-string j-assoc-2))
+	 nil :revision 100)))))
+
+
+
 (defun run-jtm-tests()
   "Runs all tests of this test-suite."
   (it.bese.fiveam:run! 'jtm-tests))
\ No newline at end of file




More information about the Isidorus-cvs mailing list