Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

jtm_test.lisp

Last change on this file was 470, checked in by lgiessmann, 14 years ago
fixed ticket #111 and adapted all unit-tests
File size: 144.3 KB

Line
1	;;+-----------------------------------------------------------------------------
2	;;+ Isidorus
3	;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4	;;+
5	;;+ Isidorus is freely distributable under the LLGPL license.
6	;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7	;;+ trunk/docs/LGPL-LICENSE.txt.
8	;;+-----------------------------------------------------------------------------
9
10	(defpackage :jtm-test
11	(:use
12	:common-lisp
13	:jtm
14	:constants
15	:base-tools
16	:xtm-importer
17	:datamodel
18	:it.bese.FiveAM
19	:unittests-constants
20	:fixtures)
21	(:export :test-create-prefixes
22	:test-identifiers-to-jtm
23	:test-topic-reference
24	:test-type-scopes-reifier-to-jtm
25	:test-parent-references-to-jtm
26	:run-jtm-tests
27	:test-instance-ofs-to-jtm
28	:test-export-to-jtm-variant
29	:test-export-to-jtm-name
30	:test-export-to-jtm-occurrence
31	:test-export-to-jtm-topic
32	:test-export-to-jtm-role
33	:test-export-to-jtm-association
34	:test-export-to-jtm-fragment
35	:test-export-as-jtm
36	:test-import-jtm-references-1
37	:test-import-jtm-references-2
38	:test-get-item
39	:test-import-identifiers
40	:test-import-variants
41	:test-import-occurrences
42	:test-import-names
43	:test-make-instance-of-association
44	:test-import-topics
45	:test-merge-topics
46	:test-import-associations
47	:test-import-roles
48	:test-import-topic-maps-1
49	:test-import-topic-maps-2
50	:test-import-topic-maps-3
51	:test-import-topic-maps-4
52	:test-import-topic-maps-5
53	:test-import-construct-from-jtm-string
54	:test-import-from-jtm-1
55	:test-import-from-jtm-2
56	:test-import-from-jtm-3))
57
58
59	(in-package :jtm-test)
60
61
62	(def-suite jtm-tests
63	:description "tests various functions of the jtm module")
64
65	(in-suite jtm-tests)
66
67
68	(test test-create-prefixes
69	"Tests the functions that are responsible for generating xml-prefix-suffix
70	pairs."
71	(with-fixture with-tm-filled-db ("data_base" sparql_test.xtm)
72	(let* ((goethe
73	(get-item-by-psi "http://some.where/tmsparql/author/goethe"
74	:revision 0))
75	(goethe-tm (first (in-topicmaps goethe :revision 0)))
76	(goethe-assocs (map 'list #'(lambda(role)
77	(parent role :revision 0))
78	(player-in-roles goethe :revision 0)))
79	(prefixes (jtm::create-prefix-list-for-tm (list goethe) goethe-assocs
80	goethe-tm :revision 0)))
81	(is (= (length prefixes) 4))
82	(is-false
83	(set-exclusive-or (list "pref_1" "pref_2" "pref_3" "xsd")
84	(map 'list #'(lambda(item) (getf item :pref)) prefixes)
85	:test #'string=))
86	(is-false
87	(set-exclusive-or (list "http://some.where/tmsparql/author/"
88	"http://some.where/ii/"
89	"http://www.isidor.us/unittests/"
90	xsd-ns)
91	(map 'list #'(lambda(item) (getf item :value)) prefixes)
92	:test #'string=)))))
93
94
95	(test test-topic-reference
96	"Tests all functions that are corresponding for topic references."
97	(with-fixture with-empty-db ("data_base")
98	(let ((top-1 (make-construct 'TopicC
99	:start-revision 100
100	:psis
101	(list
102	(make-construct 'PersistentIdC
103	:uri "http://some.where/example/psi-1"))))
104	(top-2 (make-construct 'TopicC
105	:start-revision 100
106	:item-identifiers
107	(list
108	(make-construct 'ItemIdentifierC
109	:uri "http://some.where/example/ii-1"))))
110	(top-3 (make-construct 'TopicC
111	:start-revision 100
112	:locators
113	(list
114	(make-construct 'SubjectLocatorC
115	:uri "http://some.where/example/sl-1"))))
116	(top-4 (make-construct 'TopicC :start-revision 100))
117	(top-5 (make-construct 'TopicC
118	:start-revision 100
119	:psis
120	(list
121	(make-instance 'PersistentIdC
122	:uri "http://some.where/example#psi-2")
123	(make-instance 'PersistentIdC
124	:uri "http://some.where/example#psi-3"))
125	:item-identifiers
126	(list
127	(make-instance 'ItemIdentifierC
128	:uri "http://some.where/example#ii-2")
129	(make-instance 'ItemIdentifierC
130	:uri "http://some.where/example#ii-3"))
131	:locators
132	(list
133	(make-instance 'SubjectLocatorC
134	:uri "http://some.where/example#sl-2")
135	(make-instance 'SubjectLocatorC
136	:uri "http://some.where/example#sl-3"))))
137	(prefixes (list (list :pref "pref_1" :value "http://some.where/example#")
138	(list :pref "pref_2" :value "http://some.where/")
139	(list :pref "pref_3" :value "http://any.prefix/"))))
140	(is (string= (jtm::export-topic-reference-to-jtm top-1 :revision 0)
141	"\"si:http:\\/\\/some.where\\/example\\/psi-1\""))
142	(is (string= (jtm::export-topic-reference-to-jtm top-2 :revision 0)
143	"\"ii:http:\\/\\/some.where\\/example\\/ii-1\""))
144	(is (string= (jtm::export-topic-reference-to-jtm top-3 :revision 0)
145	"\"sl:http:\\/\\/some.where\\/example\\/sl-1\""))
146	(signals exceptions::JTM-error
147	(jtm::export-topic-reference-to-jtm top-4 :revision 0))
148	(is (string= (jtm::export-topic-reference-to-jtm top-5 :revision 0)
149	"\"si:http:\\/\\/some.where\\/example#psi-2\""))
150	(is (string= (jtm::export-topic-reference-to-jtm top-1 :revision 0
151	:prefixes prefixes)
152	"\"si:[pref_2:example\\/psi-1]\""))
153	(is (string= (jtm::export-topic-reference-to-jtm top-2 :revision 0
154	:prefixes prefixes)
155	"\"ii:[pref_2:example\\/ii-1]\""))
156	(is (string= (jtm::export-topic-reference-to-jtm top-3 :revision 0
157	:prefixes prefixes)
158	"\"sl:[pref_2:example\\/sl-1]\""))
159	(is (string= (jtm::export-topic-reference-to-jtm top-5 :revision 0
160	:prefixes prefixes)
161	"\"si:[pref_1:psi-2]\""))
162	(is (string= (jtm::export-topic-reference-to-jtm
163	top-5 :revision 0
164	:prefixes (list (list :pref "pref_1"
165	:value "http://some.where/example#psi-2")))
166	"\"si:http:\\/\\/some.where\\/example#psi-2\""))
167	(is (string= (jtm::export-topic-reference-to-jtm
168	top-5 :revision 0
169	:prefixes (list (list :pref "pref_1"
170	:value "http://any.pref/example#psi-2")))
171	"\"si:http:\\/\\/some.where\\/example#psi-2\"")))))
172
173
174	(test test-identifiers-to-jtm
175	"Tests the function export-identifiers-to-jtm."
176	(with-fixture with-empty-db ("data_base")
177	(let ((top-1 (make-construct 'TopicC
178	:start-revision 100
179	:psis
180	(list
181	(make-construct 'PersistentIdC
182	:uri "http://some.where/example/psi-1"))))
183	(top-2 (make-construct 'TopicC
184	:start-revision 100
185	:item-identifiers
186	(list
187	(make-construct 'ItemIdentifierC
188	:uri "http://some.where/example/ii-1"))))
189	(top-3 (make-construct 'TopicC
190	:start-revision 100
191	:locators
192	(list
193	(make-construct 'SubjectLocatorC
194	:uri "http://some.where/example/sl-1"))))
195	(top-5 (make-construct 'TopicC
196	:start-revision 100
197	:psis
198	(list
199	(make-instance 'PersistentIdC
200	:uri "http://some.where/example#psi-2")
201	(make-instance 'PersistentIdC
202	:uri "http://some.where/example#psi-3"))
203	:item-identifiers
204	(list
205	(make-instance 'ItemIdentifierC
206	:uri "http://some.where/example#ii-2")
207	(make-instance 'ItemIdentifierC
208	:uri "http://some.where/example#ii-3"))
209	:locators
210	(list
211	(make-instance 'SubjectLocatorC
212	:uri "http://some.where/example#sl-2")
213	(make-instance 'SubjectLocatorC
214	:uri "http://some.where/example#sl-3"))))
215	(name-1 (make-construct 'NameC
216	:start-revision 100
217	:item-identifiers
218	(list
219	(make-construct
220	'ItemIdentifierC
221	:uri "http://some.where/example/ii-5"))))
222	(prefixes (list (list :pref "pref_1" :value "http://some.where/example#")
223	(list :pref "pref_2" :value "http://some.where/")
224	(list :pref "pref_3" :value "http://any.prefix/"))))
225	(is (string= (jtm::export-identifiers-to-jtm top-1 :revision 0
226	:identifier-type 'PersistentIdC)
227	"[\"http:\\/\\/some.where\\/example\\/psi-1\"]"))
228	(is (string= (jtm::export-identifiers-to-jtm top-1 :revision 0
229	:identifier-type 'PersistentIdC
230	:prefixes prefixes)
231	"[\"[pref_2:example\\/psi-1]\"]"))
232	(is (string= (jtm::export-identifiers-to-jtm top-1 :revision 0
233	:identifier-type 'SubjectLocatorC)
234	"null"))
235	(is (string= (jtm::export-identifiers-to-jtm top-1 :revision 0)
236	"null"))
237	(is (string= (jtm::export-identifiers-to-jtm top-2 :revision 0)
238	"[\"http:\\/\\/some.where\\/example\\/ii-1\"]"))
239	(is (string= (jtm::export-identifiers-to-jtm top-2 :revision 0
240	:prefixes prefixes)
241	"[\"[pref_2:example\\/ii-1]\"]"))
242	(is (string= (jtm::export-identifiers-to-jtm top-2 :revision 0
243	:identifier-type 'SubjectLocatorC)
244	"null"))
245	(is (string= (jtm::export-identifiers-to-jtm top-2 :revision 0
246	:identifier-type 'PersistentIdC)
247	"null"))
248	(is (string= (jtm::export-identifiers-to-jtm top-3 :revision 0
249	:identifier-type 'SubjectLocatorC)
250	"[\"http:\\/\\/some.where\\/example\\/sl-1\"]"))
251	(is (string= (jtm::export-identifiers-to-jtm top-3 :revision 0
252	:identifier-type 'SubjectLocatorC
253	:prefixes prefixes)
254	"[\"[pref_2:example\\/sl-1]\"]"))
255	(is (string= (jtm::export-identifiers-to-jtm top-3 :revision 0
256	:identifier-type 'PersistentIdC)
257	"null"))
258	(is (string= (jtm::export-identifiers-to-jtm top-3 :revision 0)
259	"null"))
260	(signals exceptions:JTM-error
261	(jtm::export-identifiers-to-jtm top-3 :revision 0 :identifier-type 'AnyType))
262	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0
263	:identifier-type 'PersistentIdC)
264	"[\"http:\\/\\/some.where\\/example#psi-2\",\"http:\\/\\/some.where\\/example#psi-3\"]"))
265	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0
266	:identifier-type 'PersistentIdC
267	:prefixes prefixes)
268	"[\"[pref_1:psi-2]\",\"[pref_1:psi-3]\"]"))
269	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0
270	:identifier-type 'SubjectLocatorC)
271	"[\"http:\\/\\/some.where\\/example#sl-2\",\"http:\\/\\/some.where\\/example#sl-3\"]"))
272	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0
273	:identifier-type 'SubjectLocatorC
274	:prefixes prefixes)
275	"[\"[pref_1:sl-2]\",\"[pref_1:sl-3]\"]"))
276	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0)
277	"[\"http:\\/\\/some.where\\/example#ii-2\",\"http:\\/\\/some.where\\/example#ii-3\"]"))
278	(is (string= (jtm::export-identifiers-to-jtm top-5 :revision 0
279	:prefixes prefixes)
280	"[\"[pref_1:ii-2]\",\"[pref_1:ii-3]\"]"))
281
282	(is (string= (jtm::export-identifiers-to-jtm
283	top-5 :revision 0
284	:prefixes (list (list :pref "pref_1"
285	:value "http://some.where/example#psi-2")))
286	"[\"http:\\/\\/some.where\\/example#ii-2\",\"http:\\/\\/some.where\\/example#ii-3\"]"))
287	(is (string= (jtm::export-identifiers-to-jtm
288	top-5 :revision 0
289	:prefixes (list (list :pref "pref_1"
290	:value "http://any.pref/example#psi-2")))
291	"[\"http:\\/\\/some.where\\/example#ii-2\",\"http:\\/\\/some.where\\/example#ii-3\"]"))
292	(is (string= (jtm::export-identifiers-to-jtm name-1 :revision 0)
293	"[\"http:\\/\\/some.where\\/example\\/ii-5\"]"))
294	(is (string= (jtm::export-identifiers-to-jtm name-1 :revision 0
295	:prefixes prefixes)
296	"[\"[pref_2:example\\/ii-5]\"]")))))
297
298
299
300	(test test-type-scopes-reifier-to-jtm
301	"Tests the functions export-type-to-jtm, export-scopes-to-jtm,
302	and export-reifier-to-jtm."
303	(with-fixture with-empty-db ("data_base")
304	(let* ((top-1 (make-construct 'TopicC
305	:start-revision 100
306	:psis
307	(list
308	(make-construct 'PersistentIdC
309	:uri "http://some.where/example/psi-1"))))
310	(top-2 (make-construct 'TopicC
311	:start-revision 100
312	:locators
313	(list
314	(make-construct 'SubjectLocatorC
315	:uri "http://some.where/example/sl-1"))))
316	(top-3 (make-construct 'TopicC :start-revision 100))
317	(name-1 (make-construct 'NameC :start-revision 100
318	:charvalue "name-1"
319	:instance-of top-1))
320	(name-2 (make-construct 'NameC :start-revision 100
321	:charvalue "name-2"))
322	(name-3 (make-construct 'NameC :start-revision 100
323	:charvalue "name-3"
324	:instance-of top-3))
325	(occ-1 (make-construct 'OccurrenceC :start-revision 100
326	:charvalue "occ-1"
327	:themes (list top-1 top-2)))
328	(occ-2 (make-construct 'OccurrenceC :start-revision 100
329	:charvalue (list top-1 top-2)))
330	(occ-3 (make-construct 'OccurrenceC :start-revision 100
331	:charvalue "occ-3"
332	:themes (list top-1 top-3 top-2)))
333	(assoc-1 (make-construct 'AssociationC :start-revision 100
334	:reifier top-1))
335	(name-4 (make-construct 'NameC :start-revision 100
336	:charvalue "name-4"))
337	(occ-4 (make-construct 'OccurrenceC :start-revision 100
338	:charvalue "occ-4"
339	:reifier top-3))
340	(prefixes (list (list :pref "pref_1" :value "http://some.where/example/"))))
341	(is (string= (jtm::export-type-to-jtm name-1 :revision 0)
342	"\"si:http:\\/\\/some.where\\/example\\/psi-1\""))
343	(is (string= (jtm::export-type-to-jtm name-1 :revision 0 :prefixes prefixes)
344	"\"si:[pref_1:psi-1]\""))
345	(is (string= (jtm::export-type-to-jtm name-2 :revision 0 :prefixes prefixes
346	:error-if-nil nil)
347	"null"))
348	(signals exceptions:JTM-error (jtm::export-type-to-jtm name-3 :revision 0))
349	(is (or (string= (jtm::export-scopes-to-jtm occ-1 :revision 0)
350	"[\"si:http:\\/\\/some.where\\/example\\/psi-1\",\"sl:http:\\/\\/some.where\\/example\\/sl-1\"]")
351	(string= (jtm::export-scopes-to-jtm occ-1 :revision 0)
352	"[\"sl:http:\\/\\/some.where\\/example\\/sl-1\",\"si:http:\\/\\/some.where\\/example\\/psi-1\"]")))
353	(is (or (string= (jtm::export-scopes-to-jtm occ-1 :revision 0
354	:prefixes prefixes)
355	"[\"si:[pref_1:psi-1]\",\"sl:[pref_1:sl-1]\"]")
356	(string= (jtm::export-scopes-to-jtm occ-1 :revision 0
357	:prefixes prefixes)
358	"[\"sl:[pref_1:sl-1]\",\"si:[pref_1:psi-1]\"]")))
359	(is (string= (jtm::export-scopes-to-jtm occ-2 :revision 0)
360	"null"))
361	(signals exceptions:JTM-error (jtm::export-scopes-to-jtm occ-3 :revision 0))
362	(is (string= (jtm::export-reifier-to-jtm assoc-1 :revision 0)
363	"\"si:http:\\/\\/some.where\\/example\\/psi-1\""))
364	(is (string= (jtm::export-reifier-to-jtm name-4 :revision 0)
365	"null"))
366	(signals exceptions::JTM-error (jtm::export-reifier-to-jtm occ-4 :revision 0)))))
367
368
369	(test test-parent-references-to-jtm
370	"Tests the function export-parent-references-to-jtm."
371	(with-fixture with-empty-db ("data_base")
372	(let* ((var-1 (make-construct 'VariantC :start-revision 100
373	:charvalue "var-1"))
374	(var-2 (make-construct 'VariantC :start-revision 100))
375	(name-1 (make-construct 'NameC :start-revision 100
376	:item-identifiers
377	(list (make-construct
378	'ItemIdentifierC
379	:uri "http://some.where/example/ii-1"))
380	:charvalue "name-1"
381	:variants (list var-1)))
382	(name-2 (make-construct 'NameC :start-revision 100
383	:charvalue "name-2"))
384	(occ-1 (make-construct 'OccurrenceC :start-revision 100
385	:charvalue "occ-1"))
386	(top-1 (make-construct 'TopicC :start-revision 100
387	:names (list name-1)
388	:psis
389	(list
390	(make-construct 'PersistentIdC
391	:uri "http://some.where/example/psi-1"))))
392	(top-2 (make-construct 'TopicC :start-revision 100
393	:occurrences (list occ-1)
394	:locators
395	(list
396	(make-construct 'SubjectLocatorC
397	:uri "http://some.where/example/sl-1"))))
398	(top-3 (make-construct 'TopicC :start-revision 100
399	:names (list name-2)))
400	(assoc-1 (make-construct 'AssociationC :start-revision 100
401	:item-identifiers
402	(list (make-construct
403	'ItemIdentifierC
404	:uri "http://some.where/example/ii-3"))
405	:roles (list (list :player top-1
406	:start-revision 100))))
407	(tm (make-construct 'TopicMapC :start-revision 100
408	:topics (list top-3)
409	:associations (list assoc-1)
410	:item-identifiers
411	(list (make-construct
412	'ItemIdentifierC
413	:uri "http://some.where/example/ii-2"))))
414	(assoc-2 (make-construct 'AssociationC :start-revision 100
415	:roles (list (list :player top-2
416	:start-revision 100))))
417	(role-1 (first (roles assoc-1 :revision 0)))
418	(role-2 (first (roles assoc-2 :revision 0)))
419	(prefixes (list (list :pref "pref_1" :value "http://some.where/example/"))))
420	(setf TM-REVISION 0)
421	(is (string= (jtm::export-parent-references-to-jtm top-3)
422	"[\"ii:http:\\/\\/some.where\\/example\\/ii-2\"]"))
423	(is (string= (jtm::export-parent-references-to-jtm top-3 :prefixes prefixes)
424	"[\"ii:[pref_1:ii-2]\"]"))
425	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm top-1))
426	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm assoc-2))
427	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm tm))
428	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm name-2))
429	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm var-2))
430	(signals exceptions:JTM-error (jtm::export-parent-references-to-jtm role-2))
431	(is-true role-1)
432	(is-true role-2)
433	(is (string= (jtm::export-parent-references-to-jtm var-1)
434	"[\"ii:http:\\/\\/some.where\\/example\\/ii-1\"]"))
435	(is (string= (jtm::export-parent-references-to-jtm var-1 :prefixes prefixes)
436	"[\"ii:[pref_1:ii-1]\"]"))
437	(is (string= (jtm::export-parent-references-to-jtm name-1)
438	"[\"si:http:\\/\\/some.where\\/example\\/psi-1\"]"))
439	(is (string= (jtm::export-parent-references-to-jtm name-1 :prefixes prefixes)
440	"[\"si:[pref_1:psi-1]\"]"))
441	(is (string= (jtm::export-parent-references-to-jtm occ-1)
442	"[\"sl:http:\\/\\/some.where\\/example\\/sl-1\"]"))
443	(is (string= (jtm::export-parent-references-to-jtm occ-1 :prefixes prefixes)
444	"[\"sl:[pref_1:sl-1]\"]"))
445	(is (string= (jtm::export-parent-references-to-jtm assoc-1)
446	"[\"ii:http:\\/\\/some.where\\/example\\/ii-2\"]"))
447	(is (string= (jtm::export-parent-references-to-jtm assoc-1 :prefixes prefixes)
448	"[\"ii:[pref_1:ii-2]\"]"))
449	(is (string= (jtm::export-parent-references-to-jtm role-1)
450	"[\"ii:http:\\/\\/some.where\\/example\\/ii-3\"]"))
451	(is (string= (jtm::export-parent-references-to-jtm role-1 :prefixes prefixes)
452	"[\"ii:[pref_1:ii-3]\"]")))))
453
454
455	(test test-instance-ofs-to-jtm
456	"Tests the function export-instance-ofs-to-jtm."
457	(with-fixture with-empty-db ("data_base")
458	(let* ((top-1 (make-construct 'TopicC :start-revision 100
459	:psis
460	(list
461	(make-construct 'PersistentIdC
462	:uri "http://some.where/example#psi-1"))))
463	(top-2 (make-construct 'TopicC :start-revision 100
464	:locators
465	(list
466	(make-construct 'SubjectLocatorC
467	:uri "http://some.where/example#sl-1"))))
468	(top-3 (make-construct 'TopicC :start-revision 100
469	:item-identifiers
470	(list
471	(make-construct 'ItemIdentifierC
472	:uri "http://some.where/example#ii-1"))))
473	(top-4 (make-construct 'TopicC :start-revision 100))
474	(top-5 (make-construct 'TopicC :start-revision 100))
475	(tit (make-construct 'TopicC :start-revision 100
476	:psis (list (make-construct
477	'PersistentIdC
478	:uri type-instance-psi))))
479	(it (make-construct 'TopicC :start-revision 100
480	:psis (list (make-construct 'PersistentIdC
481	:uri instance-psi))))
482	(tt (make-construct 'TopicC :start-revision 100
483	:psis (list (make-construct 'PersistentIdC
484	:uri type-psi))))
485	(prefixes (list (list :pref "pref_1" :value "http://some.where/"))))
486	(make-construct 'AssociationC :start-revision 100
487	:roles (list (list :player top-1 :instance-of tt
488	:start-revision 100)
489	(list :player top-4 :instance-of it
490	:start-revision 100))
491	:instance-of tit)
492	(make-construct 'AssociationC :start-revision 100
493	:roles (list (list :player top-2 :instance-of tt
494	:start-revision 100)
495	(list :player top-4 :instance-of it
496	:start-revision 100))
497	:instance-of tit)
498	(make-construct 'AssociationC :start-revision 100
499	:roles (list (list :player top-3 :instance-of tt
500	:start-revision 100)
501	(list :player top-5 :instance-of it
502	:start-revision 100))
503	:instance-of tit)
504	(setf TM-REVISION 0)
505	(is (string= (jtm::export-instance-ofs-to-jtm top-5)
506	"[\"ii:http:\\/\\/some.where\\/example#ii-1\"]"))
507	(is (string= (jtm::export-instance-ofs-to-jtm top-5 :prefixes prefixes)
508	"[\"ii:[pref_1:example#ii-1]\"]"))
509	(is (string= (jtm::export-instance-ofs-to-jtm top-1)
510	"null"))
511	(is (or (string= (jtm::export-instance-ofs-to-jtm top-4)
512	"[\"si:http:\\/\\/some.where\\/example#psi-1\",\"sl:http:\\/\\/some.where\\/example#sl-1\"]")
513	(string= (jtm::export-instance-ofs-to-jtm top-4)
514	"[\"sl:http:\\/\\/some.where\\/example#sl-1\",\"si:http:\\/\\/some.where\\/example#psi-1\"]")))
515	(is (or (string= (jtm::export-instance-ofs-to-jtm top-4 :prefixes prefixes)
516	"[\"si:[pref_1:example#psi-1]\",\"sl:[pref_1:example#sl-1]\"]")
517	(string= (jtm::export-instance-ofs-to-jtm top-4 :prefixes prefixes)
518	"[\"sl:[pref_1:example#sl-1]\",\"si:[pref_1:example#psi-1]\"]")))
519	(make-construct 'AssociationC :start-revision 100
520	:roles (list (list :player top-4 :instance-of tt
521	:start-revision 100)
522	(list :player top-5 :instance-of it
523	:start-revision 100))
524	:instance-of tit)
525	(signals exceptions:JTM-error (jtm::export-instance-ofs-to-jtm top-5)))))
526
527
528	(test test-export-to-jtm-variant
529	"Tests the function export-to-jtm bound to VariantC and the function
530	export-construct-as-jtm-string also bound to VariantC."
531	(with-fixture with-empty-db ("data_base")
532	(let* ((name-1 (make-construct 'NameC :start-revision 100
533	:item-identifiers
534	(list
535	(make-construct 'ItemIdentifierC
536	:uri "http://some.where/ii-1"))
537	:charvalue "name-1"))
538	(top-1
539	(make-construct 'TopicC :start-revision 100
540	:psis
541	(list (make-construct 'PersistentIdC
542	:uri "http://some.where/psi-1"))))
543	(top-2
544	(make-construct 'TopicC :start-revision 100
545	:locators
546	(list (make-construct 'SubjectLocatorC
547	:uri "http://some.where/sl-1"))))
548	(top-3
549	(make-construct 'TopicC :start-revision 100
550	:item-identifiers
551	(list (make-construct 'ItemIdentifierC
552	:uri "http://some.where/ii-2"))))
553	(var-1 (make-construct 'VariantC :start-revision 100
554	:charvalue "var-1"
555	:datatype xml-string
556	:themes (list top-1)
557	:parent name-1))
558	(var-2 (make-construct 'VariantC :start-revision 100
559	:item-identifiers
560	(list
561	(make-construct 'ItemIdentifierC
562	:uri "http://some.where/ii-3"))
563	:charvalue "http://any.uri"
564	:themes (list top-2)
565	:reifier top-3
566	:datatype xml-uri))
567	(jtm-1 (jtm::export-to-jtm var-1 :item-type-p nil :revision 0))
568	(jtm-2 (jtm::export-to-jtm var-2 :item-type-p nil :revision 0))
569	(jtm-str-1 (export-construct-as-jtm-string var-1 :revision 0))
570	(jtm-str-2 (export-construct-as-jtm-string
571	var-2 :jtm-format :1.0 :parent-p nil :revision 0)))
572	(is (string= jtm-1
573	(concat "{\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-string) ",\"value\":\"var-1\",\"scope\":[\"si:http:\\/\\/some.where\\/psi-1\"],\"reifier\":null}")))
574	(is (string= jtm-2
575	(concat "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-3\"],\"datatype\":" (json:encode-json-to-string xml-uri) ",\"value\":\"http:\\/\\/any.uri\",\"scope\":[\"sl:http:\\/\\/some.where\\/sl-1\"],\"reifier\":\"ii:http:\\/\\/some.where\\/ii-2\"}")))
576	(is (string= jtm-str-1
577	(concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-string) ",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}")))
578	(is (string= jtm-str-2
579	(concat "{\"version\":\"1.0\",\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-3\"],\"datatype\":" (json:encode-json-to-string xml-uri) ",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"variant\",\"scope\":[\"sl:http:\\/\\/some.where\\/sl-1\"],\"reifier\":\"ii:http:\\/\\/some.where\\/ii-2\"}"))))))
580
581
582	(test test-export-to-jtm-name
583	"Tests the function export-to-jtm bound to NameC and the function
584	export-construct-as-jtm-string also bound to NameC."
585	(with-fixture with-empty-db ("data_base")
586	(let* ((top-1 (make-construct 'TopicC :start-revision 100
587	:psis
588	(list
589	(make-construct 'PersistentIdC
590	:uri "http://some.where/psi-1"))))
591	(top-2 (make-construct 'TopicC :start-revision 100
592	:locators
593	(list
594	(make-construct 'SubjectLocatorC
595	:uri "http://some.where/sl-1"))))
596	(top-3 (make-construct 'TopicC :start-revision 100
597	:item-identifiers
598	(list
599	(make-construct 'ItemIdentifierC
600	:uri "http://some.where/ii-1"))))
601	(var-1 (make-construct 'VariantC :start-revision 100
602	:themes (list top-2)
603	:charvalue "var-1"))
604	(var-2 (make-construct 'VariantC :start-revision 100
605	:themes (list top-2)
606	:charvalue "var-2"))
607	(name-1 (make-construct 'NameC :start-revision 100
608	:item-identifiers
609	(list
610	(make-construct 'ItemIdentifierC
611	:uri "http://some.where/ii-2"))
612	:themes (list top-1)
613	:instance-of top-2
614	:reifier top-3
615	:charvalue "name-1"
616	:parent top-1
617	:variants (list var-1 var-2)))
618	(name-2 (make-construct 'NameC :start-revision 100
619	:charvalue "name-2"))
620	(jtm-1 (jtm::export-to-jtm name-1 :item-type-p nil :revision 0))
621	(jtm-2 (jtm::export-to-jtm name-2 :item-type-p nil :revision 0))
622	(jtm-str-1 (export-construct-as-jtm-string name-1 :revision 0))
623	(jtm-str-2 (export-construct-as-jtm-string
624	name-2 :jtm-format :1.0 :parent-p nil :revision 0))
625	(prefixes (list (list :pref "pref_1" :value xsd-ns)
626	(list :pref "xsd" :value xsd-ns)
627	(list :pref "pref_2" :value "http://some.where/"))))
628	(is (string= jtm-1
629	(concat "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-2\"],\"value\":\"name-1\",\"type\":\"sl:http:\\/\\/some.where\\/sl-1\",\"scope\":[\"si:http:\\/\\/some.where\\/psi-1\"],\"variants\":[" (jtm::export-to-jtm var-1 :item-type-p nil :revision 0) "," (jtm::export-to-jtm var-2 :item-type-p nil :revision 0) "],\"reifier\":\"ii:http:\\/\\/some.where\\/ii-1\"}")))
630	(is (string= jtm-2
631	"{\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"scope\":null,\"variants\":null,\"reifier\":null}"))
632	(is (string= jtm-str-1
633	(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\":[" (jtm::export-to-jtm var-1 :item-type-p nil :revision 0 :prefixes prefixes) "," (jtm::export-to-jtm var-2 :item-type-p nil :revision 0 :prefixes prefixes) "],\"reifier\":\"ii:[pref_2:ii-1]\"}")))
634	(is (string= jtm-str-2
635	"{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"scope\":null,\"variants\":null,\"reifier\":null}")))))
636
637
638
639	(test test-export-to-jtm-occurrence
640	"Tests the function export-to-jtm bound to OccurrenceC and the function
641	export-construct-as-jtm-string also bound to OccurrenceC."
642	(with-fixture with-empty-db ("data_base")
643	(let* ((top-1 (make-construct 'TopicC :start-revision 100
644	:psis
645	(list
646	(make-construct 'PersistentIdC
647	:uri "http://some.where/psi-1"))))
648	(top-2 (make-construct 'TopicC :start-revision 100
649	:locators
650	(list
651	(make-construct 'SubjectLocatorC
652	:uri "http://some.where/sl-1"))))
653	(top-3 (make-construct 'TopicC :start-revision 100
654	:item-identifiers
655	(list
656	(make-construct 'ItemIdentifierC
657	:uri "http://some.where/ii-1"))))
658	(occ-1 (make-construct 'OccurrenceC :start-revision 100
659	:item-identifiers
660	(list
661	(make-construct 'ItemIdentifierC
662	:uri "http://some.where/ii-2"))
663	:themes (list top-1)
664	:instance-of top-2
665	:reifier top-3
666	:charvalue "occ-1"
667	:parent top-1))
668	(occ-2 (make-construct 'OccurrenceC :start-revision 100
669	:charvalue "http://any.uri"
670	:datatype xml-uri
671	:instance-of top-1))
672	(jtm-1 (jtm::export-to-jtm occ-1 :item-type-p nil :revision 0))
673	(jtm-2 (jtm::export-to-jtm occ-2 :item-type-p nil :revision 0))
674	(jtm-str-1 (export-construct-as-jtm-string occ-1 :revision 0))
675	(jtm-str-2 (export-construct-as-jtm-string
676	occ-2 :jtm-format :1.0 :parent-p nil :revision 0)))
677	(is (string= jtm-1
678	(concat "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-2\"],\"datatype\":" (json:encode-json-to-string xml-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\"}")))
679	(is (string= jtm-2
680	(concat "{\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-uri ) ",\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"value\":\"http:\\/\\/any.uri\",\"scope\":null,\"reifier\":null}")))
681	(is (string= jtm-str-1
682	(concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-2]\"],\"datatype\":" (json:encode-json-to-string xml-string ) ",\"type\":\"sl:[pref_1:sl-1]\",\"value\":\"occ-1\",\"item_type\":\"occurrence\",\"parent\":[\"si:[pref_1:psi-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":\"ii:[pref_1:ii-1]\"}")))
683	(is (string= jtm-str-2
684	(concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-uri ) ",\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}"))))))
685
686
687	(test test-export-to-jtm-topic
688	"Tests the function export-to-jtm bound to TopicC and the function
689	export-construct-as-jtm-string also bound to TopicC."
690	(with-fixture with-empty-db ("data_base")
691	(let* ((top-1 (make-construct 'TopicC :start-revision 100
692	:psis
693	(list
694	(make-construct 'PersistentIdC
695	:uri "http://some.where/psi-1")
696	(make-construct 'PersistentIdC
697	:uri "http://some.where/psi-2"))
698	:item-identifiers
699	(list
700	(make-construct 'ItemIdentifierC
701	:uri "http://some.where/ii-4"))
702	:locators
703	(list
704	(make-construct 'SubjectLocatorC
705	:uri "http://some.where/sl-2"))))
706	(top-2 (make-construct 'TopicC :start-revision 100
707	:locators
708	(list
709	(make-construct 'SubjectLocatorC
710	:uri "http://some.where/sl-1"))))
711	(top-3 (make-construct 'TopicC :start-revision 100
712	:item-identifiers
713	(list
714	(make-construct 'ItemIdentifierC
715	:uri "http://some.where/ii-1"))))
716	(occ-1 (make-construct 'OccurrenceC :start-revision 100
717	:item-identifiers
718	(list
719	(make-construct 'ItemIdentifierC
720	:uri "http://some.where/ii-2"))
721	:themes (list top-1)
722	:instance-of top-2
723	:reifier top-3
724	:charvalue "occ-1"
725	:parent top-1))
726	(occ-2 (make-construct 'OccurrenceC :start-revision 100
727	:charvalue "http://any.uri"
728	:datatype xml-uri
729	:instance-of top-1
730	:parent top-1))
731	(name-1 (make-construct 'NameC :start-revision 100
732	:charvalue "name-1"
733	:parent top-1))
734	(var-1 (make-construct 'VariantC :start-revision 100
735	:themes (list top-2 top-3)
736	:charvalue "var-1"))
737	(name-2 (make-construct 'NameC :start-revision 100
738	:charvalue "name-2"
739	:themes (list top-2)
740	:variants (list var-1)
741	:parent top-1))
742	(tm (make-construct 'TopicMapC :start-revision 100
743	:item-identifiers
744	(list
745	(make-construct 'ItemIdentifierC
746	:uri "http://some.where/ii-3"))))
747	(tt (make-construct 'TopicC :start-revision 100
748	:psis
749	(list
750	(make-construct 'PersistentIdC :start-revision 100
751	:uri type-psi))))
752	(it (make-construct 'TopicC :start-revision 100
753	:psis
754	(list
755	(make-construct 'PersistentIdC :start-revision 100
756	:uri instance-psi))))
757	(tit (make-construct 'TopicC :start-revision 100
758	:psis
759	(list
760	(make-construct 'PersistentIdC :start-revision 100
761	:uri type-instance-psi))))
762	(jtm-1 (jtm::export-to-jtm top-1 :item-type-p nil :revision 0))
763	(jtm-str-1 (export-construct-as-jtm-string
764	top-1 :revision 0 :parent-p nil))
765	(jtm-2 (progn
766	(add-to-tm tm top-1)
767	(make-construct 'AssociationC :start-revision 100
768	:instance-of tit
769	:roles (list (list :player top-1
770	:start-revision 100
771	:instance-of it)
772	(list :player top-2
773	:start-revision 100
774	:instance-of tt)))
775	(make-construct 'AssociationC :start-revision 100
776	:instance-of tit
777	:roles (list (list :player top-1
778	:start-revision 100
779	:instance-of it)
780	(list :player top-3
781	:start-revision 100
782	:instance-of tt)))
783	(jtm::export-to-jtm top-1 :item-type-p nil :revision 0)))
784	(jtm-str-2 (export-construct-as-jtm-string
785	top-1 :jtm-format :1.0 :revision 0))
786	(prefixes (list (list :pref "pref_1" :value xsd-ns)
787	(list :pref "xsd" :value xsd-ns)
788	(list :pref "pref_2" :value "http://some.where/"))))
789	(or occ-1 occ-2 name-1 name-2) ;only to avoid compilation warnings
790	(is (string= jtm-1
791	(concat "{\"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\"],\"instance_of\":null,\"names\":[" (jtm::export-to-jtm (first (names top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (names top-1 :revision 0)) :item-type-p nil :revision 0) "],\"occurrences\":[" (jtm::export-to-jtm (first (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "]}")))
792	(is (string= jtm-2
793	(concat "{\"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\"],\"instance_of\":[\"sl:http:\\/\\/some.where\\/sl-1\",\"ii:http:\\/\\/some.where\\/ii-1\"],\"names\":[" (jtm::export-to-jtm (first (names top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (names top-1 :revision 0)) :item-type-p nil :revision 0) "],\"occurrences\":[" (jtm::export-to-jtm (first (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "]}")))
794	(is (string= jtm-str-1
795	(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\\/\"},\"subject_identifiers\":[\"[pref_2:psi-1]\",\"[pref_2:psi-2]\"],\"subject_locators\":[\"[pref_2:sl-2]\"],\"item_identifiers\":[\"[pref_2:ii-4]\"],\"instance_of\":null,\"item_type\":\"topic\",\"names\":[" (jtm::export-to-jtm (first (names top-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes :prefixes-p nil) "," (jtm::export-to-jtm (second (names top-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes :prefixes-p nil) "],\"occurrences\":[" (jtm::export-to-jtm (first (occurrences top-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes :prefixes-p nil) "," (jtm::export-to-jtm (second (occurrences top-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes :prefixes-p nil) "]}")))
796	(is (string= jtm-str-2
797	(concat "{\"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\":[" (jtm::export-to-jtm (first (names top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (names top-1 :revision 0)) :item-type-p nil :revision 0) "],\"occurrences\":[" (jtm::export-to-jtm (first (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (occurrences top-1 :revision 0)) :item-type-p nil :revision 0) "]}"))))))
798
799
800	(test test-export-to-jtm-role
801	"Tests the function export-to-jtm bound to RoleC and the function
802	export-construct-as-jtm-string also bound to RoleC."
803	(with-fixture with-empty-db ("data_base")
804	(let* ((top-1 (make-construct 'TopicC :start-revision 100
805	:psis
806	(list
807	(make-construct 'PersistentIdC
808	:uri "http://some.where/psi-1"))))
809	(top-2 (make-construct 'TopicC :start-revision 100
810	:locators
811	(list
812	(make-construct 'SubjectLocatorC
813	:uri "http://some.where/sl-1"))))
814	(top-3 (make-construct 'TopicC :start-revision 100
815	:item-identifiers
816	(list
817	(make-construct 'ItemIdentifierC
818	:uri "http://some.where/ii-1"))))
819	(top-4 (make-construct 'TopicC :start-revision 100
820	:locators
821	(list
822	(make-construct 'SubjectLocatorC
823	:uri "http://some.where/sl-2"))))
824	(assoc-1 (make-construct 'AssociationC :start-revision 100
825	:item-identifiers
826	(list
827	(make-construct 'ItemIdentifierC
828	:uri "http://some.where/ii-2"))))
829	(role-1 (make-construct 'RoleC :start-revision 100
830	:player top-1
831	:instance-of top-2
832	:item-identifiers
833	(list
834	(make-construct 'ItemIdentifierC
835	:uri "http://some.where/ii-3")
836	(make-construct 'ItemIdentifierC
837	:uri "http://some.where/ii-4"))
838	:reifier top-4
839	:parent assoc-1))
840	(role-2 (make-construct 'RoleC :start-revision 100
841	:player top-2
842	:instance-of top-3))
843	(jtm-1 (jtm::export-to-jtm role-1 :item-type-p nil :revision 0))
844	(jtm-2 (jtm::export-to-jtm role-2 :item-type-p nil :revision 0))
845	(jtm-str-1 (export-construct-as-jtm-string role-1 :revision 0))
846	(jtm-str-2 (export-construct-as-jtm-string
847	role-2 :jtm-format :1.0 :parent-p nil :revision 0)))
848	(is (string= jtm-1
849	"{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-3\",\"http:\\/\\/some.where\\/ii-4\"],\"type\":\"sl:http:\\/\\/some.where\\/sl-1\",\"reifier\":\"sl:http:\\/\\/some.where\\/sl-2\",\"player\":\"si:http:\\/\\/some.where\\/psi-1\"}"))
850	(is (string= jtm-2
851	"{\"item_identifiers\":null,\"type\":\"ii:http:\\/\\/some.where\\/ii-1\",\"reifier\":null,\"player\":\"sl:http:\\/\\/some.where\\/sl-1\"}"))
852	(is (string= jtm-str-1
853	"{\"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]\"}"))
854	(is (string= jtm-str-2
855	"{\"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\"}")))))
856
857
858	(test test-export-to-jtm-association
859	"Tests the function export-to-jtm bound to AssociationC and the function
860	export-construct-as-jtm-string also bound to AssociationC."
861	(with-fixture with-empty-db ("data_base")
862	(let* ((top-1 (make-construct 'TopicC :start-revision 100
863	:psis
864	(list
865	(make-construct 'PersistentIdC
866	:uri "http://some.where/psi-1"))))
867	(top-2 (make-construct 'TopicC :start-revision 100
868	:locators
869	(list
870	(make-construct 'SubjectLocatorC
871	:uri "http://some.where/sl-1"))))
872	(top-3 (make-construct 'TopicC :start-revision 100
873	:item-identifiers
874	(list
875	(make-construct 'ItemIdentifierC
876	:uri "http://some.where/ii-1"))))
877	(assoc-1 (make-construct 'AssociationC :start-revision 100
878	:item-identifiers
879	(list
880	(make-construct 'ItemIdentifierC
881	:uri "http://some.where/ii-2")
882	(make-construct 'ItemIdentifierC
883	:uri "http://some.where/ii-3"))
884	:instance-of top-1
885	:themes (list top-1)
886	:roles
887	(list (list :player top-1
888	:instance-of top-2
889	:start-revision 100)
890	(list :player top-2
891	:instance-of top-3
892	:start-revision 100))))
893	(assoc-2 (make-construct 'AssociationC :start-revision 100
894	:instance-of top-1
895	:reifier top-2
896	:roles
897	(list (list :player top-2
898	:instance-of top-3
899	:start-revision 100))))
900	(tm (make-construct 'TopicMapC :start-revision 100
901	:item-identifiers
902	(list
903	(make-construct 'ItemIdentifierC
904	:uri "http://some.where/ii-4"))))
905	(jtm-1 (jtm::export-to-jtm assoc-1 :item-type-p nil :revision 0))
906	(jtm-2 (jtm::export-to-jtm assoc-2 :item-type-p nil :revision 0))
907	(jtm-str-1 (progn
908	(add-to-tm tm assoc-1)
909	(export-construct-as-jtm-string assoc-1 :revision 0)))
910	(jtm-str-2 (export-construct-as-jtm-string
911	assoc-2 :jtm-format :1.0 :parent-p nil :revision 0))
912	(prefixes (list (list :pref "pref_1" :value xsd-ns)
913	(list :pref "xsd" :value xsd-ns)
914	(list :pref "pref_2" :value "http://some.where/"))))
915	(is (string= jtm-1
916	(concat "{\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-2\",\"http:\\/\\/some.where\\/ii-3\"],\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"reifier\":null,\"scope\":[\"si:http:\\/\\/some.where\\/psi-1\"],\"roles\":[" (jtm::export-to-jtm (first (roles assoc-1 :revision 0)) :item-type-p nil :revision 0) "," (jtm::export-to-jtm (second (roles assoc-1 :revision 0)) :item-type-p nil :revision 0) "]}")))
917	(is (string= jtm-2
918	(concat "{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"reifier\":\"sl:http:\\/\\/some.where\\/sl-1\",\"scope\":null,\"roles\":[" (jtm::export-to-jtm (first (roles assoc-2 :revision 0)) :item-type-p nil :revision 0)"]}")))
919	(is (string= jtm-str-1
920	(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]\",\"[pref_2:ii-3]\"],\"type\":\"si:[pref_2:psi-1]\",\"item_type\":\"association\",\"parent\":[\"ii:[pref_2:ii-4]\"],\"reifier\":null,\"scope\":[\"si:[pref_2:psi-1]\"],\"roles\":[" (jtm::export-to-jtm (first (roles assoc-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes) "," (jtm::export-to-jtm (second (roles assoc-1 :revision 0)) :item-type-p nil :revision 0 :prefixes prefixes) "]}")))
921	(is (string= jtm-str-2
922	(concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"item_type\":\"association\",\"reifier\":\"sl:http:\\/\\/some.where\\/sl-1\",\"scope\":null,\"roles\":[" (jtm::export-to-jtm (first (roles assoc-2 :revision 0)) :item-type-p nil :revision 0)"]}"))))))
923
924
925	(test test-export-to-jtm-fragment
926	"Tests the function export-to-jtm bound to FragmentC and the function
927	export-construct-as-jtm-string also bound to FragmentC."
928	(with-fixture with-tm-filled-db ("data_base" sparql_test.xtm)
929	(let* ((fragment
930	(d::create-latest-fragment-of-topic
931	"http://some.where/tmsparql/author/goethe"))
932	(jtm-1 (jtm::export-to-jtm fragment :item-type-p nil :revision 0))
933	(jtm-str-1 (export-construct-as-jtm-string fragment :revision 0))
934	(jtm-str-2 (export-construct-as-jtm-string
935	fragment :jtm-format :1.0 :parent-p nil :revision 0))
936	(prefixes (list
937	(list :pref "pref_1"
938	:value "http://some.where/tmsparql/author/")
939	(list :pref "xsd" :value xsd-ns)
940	(list :pref "pref_3" :value "http://some.where/psis/poem/")
941	(list :pref "pref_2" :value "http://some.where/tmsparql/")
942	(list :pref "pref_4" :value "http://some.where/ii/zb/")
943	(list :pref "pref_5" :value "http://some.where/ii/"))))
944	(is (string= jtm-1
945	(concat "{\"topics\":"
946	(jtm::export-topics-to-jtm
947	(append (d:referenced-topics fragment)
948	(list (d:topic fragment))
949	(list
950	(d:get-item-by-psi type-instance-psi
951	:revision 0)
952	(d:get-item-by-psi instance-psi
953	:revision 0)
954	(d:get-item-by-psi type-psi
955	:revision 0)))
956	:item-type-p nil :parent-p nil :prefixes nil
957	:revision 0 :instance-of-p nil)
958	",\"associations\":"
959	(jtm::export-associations-to-jtm
960	(append
961	(d:associations fragment)
962	(instance-of-associations (topic fragment) :revision 0))
963	:item-type-p nil :parent-p nil :prefixes nil :revision 0)
964	",\"item_identifiers\":null,\"reifier\":null}")))
965	(is (string= jtm-str-1
966	(concat "{\"version\":\"1.1\",\"prefixes\":"
967	(jtm::export-prefix-list-to-jtm prefixes)
968	",\"topics\":"
969	(jtm::export-topics-to-jtm
970	(append (d:referenced-topics fragment)
971	(list (d:topic fragment)))
972	:item-type-p nil :parent-p nil :prefixes prefixes
973	:revision 0 :instance-of-p t)
974	",\"associations\":"
975	(jtm::export-associations-to-jtm
976	(d:associations fragment)
977	:item-type-p nil :parent-p nil
978	:prefixes prefixes :revision 0)
979	",\"item_type\":\"topicmap\",\"item_identifiers\":null,\"reifier\":null}")))
980	(is (string= jtm-str-2
981	(concat "{\"version\":\"1.0\",\"topics\":"
982	(jtm::export-topics-to-jtm
983	(append (d:referenced-topics fragment)
984	(list (d:topic fragment))
985	(list
986	(d:get-item-by-psi type-instance-psi
987	:revision 0)
988	(d:get-item-by-psi instance-psi
989	:revision 0)
990	(d:get-item-by-psi type-psi
991	:revision 0)))
992	:item-type-p nil :parent-p nil :prefixes nil
993	:revision 0 :instance-of-p nil)
994	",\"associations\":"
995	(jtm::export-associations-to-jtm
996	(append
997	(d:associations fragment)
998	(instance-of-associations (topic fragment) :revision 0))
999	:item-type-p nil :parent-p nil :prefixes nil :revision 0)
1000	",\"item_type\":\"topicmap\",\"item_identifiers\":null,\"reifier\":null}"))))))
1001
1002
1003	(test test-export-as-jtm
1004	"Tests the function export-as-jtm."
1005	(with-fixture with-tm-filled-db ("data_base" sparql_test.xtm)
1006	(let ((jtm-path-1
1007	(merge-pathnames
1008	(asdf:component-pathname
1009	(asdf:find-component constants:isidorus-system "unit_tests"))
1010	"out_sparql_xtm_1.jtm"))
1011	(jtm-path-2
1012	(merge-pathnames
1013	(asdf:component-pathname
1014	(asdf:find-component constants:isidorus-system "unit_tests"))
1015	"out_sparql_xtm_2.jtm"))
1016	(jtm-path-3
1017	(merge-pathnames
1018	(asdf:component-pathname
1019	(asdf:find-component constants:isidorus-system "unit_tests"))
1020	"out_sparql_xtm_3.jtm"))
1021	(jtm-path-4
1022	(merge-pathnames
1023	(asdf:component-pathname
1024	(asdf:find-component constants:isidorus-system "unit_tests"))
1025	"out_sparql_xtm_4.jtm")))
1026	(handler-case (delete-file jtm-path-1) (condition () nil))
1027	(handler-case (delete-file jtm-path-2) (condition () nil))
1028	(handler-case (delete-file jtm-path-3) (condition () nil))
1029	(handler-case (delete-file jtm-path-4) (condition () nil))
1030	(export-as-jtm jtm-path-1 :tm-id nil :revision 0 :jtm-format :1.1)
1031	(export-as-jtm jtm-path-2 :tm-id nil :revision 0 :jtm-format :1.0)
1032	(export-as-jtm jtm-path-3 :tm-id fixtures::tm-id :revision 0 :jtm-format :1.1)
1033	(export-as-jtm jtm-path-4 :tm-id fixtures::tm-id :revision 0 :jtm-format :1.0)
1034	(let ((jtm-str-1 (read-file-to-string jtm-path-1))
1035	(jtm-str-2 (read-file-to-string jtm-path-2))
1036	(jtm-str-3 (read-file-to-string jtm-path-3))
1037	(jtm-str-4 (read-file-to-string jtm-path-4))
1038	(prefixes (list
1039	(list :pref "pref_1"
1040	:value "http://www.topicmaps.org/xtm/1.0/core.xtm#")
1041	(list :pref "pref_2"
1042	:value "http://psi.topicmaps.org/iso13250/model/")
1043	(list :pref "pref_5"
1044	:value "http://some.where/tmsparql/author/")
1045	(list :pref "xsd" :value xsd-ns)
1046	(list :pref "pref_3"
1047	:value "http://psi.topicmaps.org/tmcl/")
1048	(list :pref "pref_6"
1049	:value "http://some.where/psis/poem/")
1050	(list :pref "pref_4"
1051	:value "http://some.where/tmsparql/")
1052	(list :pref "pref_7"
1053	:value "http://some.where/ii/zb/")
1054	(list :pref "pref_8"
1055	:value "http://some.where/ii/")))
1056	(prefixes-2 (list
1057	(list :pref "pref_3"
1058	:value "http://some.where/tmsparql/author/")
1059	(list :pref "xsd" :value xsd-ns)
1060	(list :pref "pref_7"
1061	:value "http://www.isidor.us/unittests/")
1062	(list :pref "pref_5"
1063	:value "http://psi.topicmaps.org/tmcl/")
1064	(list :pref "pref_1"
1065	:value "http://some.where/psis/poem/")
1066	(list :pref "pref_4"
1067	:value "http://some.where/tmsparql/")
1068	(list :pref "pref_2"
1069	:value "http://some.where/ii/zb/")
1070	(list :pref "pref_6"
1071	:value "http://some.where/ii/"))))
1072	(is (string= jtm-str-1
1073	(concat "{\"version\":\"1.1\",\"prefixes\":"
1074	(jtm::export-prefix-list-to-jtm prefixes)
1075	",\"item_identifiers\":null,\"topics\":"
1076	(jtm::export-topics-to-jtm
1077	(elephant:get-instances-by-class 'd:TopicC)
1078	:item-type-p nil :parent-p nil :prefixes prefixes
1079	:instance-of-p t :revision 0)
1080	",\"associations\":"
1081	(jtm::export-associations-to-jtm
1082	(remove-null
1083	(map 'list
1084	#'(lambda(assoc)
1085	(unless (eql
1086	(d:instance-of assoc :revision 0)
1087	(d:get-item-by-psi type-instance-psi
1088	:revision 0))
1089	assoc))
1090	(elephant:get-instances-by-class 'd:AssociationC)))
1091	:item-type-p nil :parent-p nil :prefixes prefixes
1092	:revision 0)
1093	",\"item_type\":\"topicmap\",\"reifier\":null}")))
1094	(is (string=
1095	jtm-str-2
1096	(concat "{\"version\":\"1.0\","
1097	"\"item_identifiers\":null,\"topics\":"
1098	(jtm::export-topics-to-jtm
1099	(elephant:get-instances-by-class 'd:TopicC)
1100	:item-type-p nil :parent-p nil
1101	:instance-of-p nil :revision 0)
1102	",\"associations\":"
1103	(jtm::export-associations-to-jtm
1104	(elephant:get-instances-by-class 'd:AssociationC)
1105	:item-type-p nil :parent-p nil :revision 0)
1106	",\"item_type\":\"topicmap\",\"reifier\":null}")))
1107	(is (string= jtm-str-3
1108	(concat "{\"version\":\"1.1\",\"prefixes\":"
1109	(jtm::export-prefix-list-to-jtm prefixes-2)
1110	",\"item_identifiers\":[\"[pref_7:testtm]\"],\"topics\":"
1111	(jtm::export-topics-to-jtm
1112	(reverse
1113	(remove
1114	(d:get-item-by-psi type-instance-psi :revision 0)
1115	(remove
1116	(d:get-item-by-psi instance-psi :revision 0)
1117	(remove
1118	(d:get-item-by-psi type-psi :revision 0)
1119	(d:topics
1120	(d:identified-construct
1121	(elephant:get-instance-by-value
1122	'd:ItemIdentifierC 'd:uri
1123	"http://www.isidor.us/unittests/testtm")
1124	:revision 0))))))
1125	:item-type-p nil :parent-p nil :prefixes prefixes-2
1126	:instance-of-p t :revision 0)
1127	",\"associations\":"
1128	(jtm::export-associations-to-jtm
1129	(remove-null
1130	(map 'list
1131	#'(lambda(assoc)
1132	(unless
1133	(eql
1134	(d:instance-of assoc :revision 0)
1135	(d:get-item-by-psi type-instance-psi
1136	:revision 0))
1137	assoc))
1138	(d:associations
1139	(d:identified-construct
1140	(elephant:get-instance-by-value
1141	'd:ItemIdentifierC 'd:uri
1142	"http://www.isidor.us/unittests/testtm")
1143	:revision 0))))
1144	:item-type-p nil :parent-p nil :prefixes prefixes-2
1145	:revision 0)
1146	",\"item_type\":\"topicmap\",\"reifier\":null}")))
1147	(is (string=
1148	jtm-str-4
1149	(concat "{\"version\":\"1.0\",\"item_identifiers\":"
1150	"[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]"
1151	",\"topics\":"
1152	(jtm::export-topics-to-jtm
1153	(d:topics
1154	(d:identified-construct
1155	(elephant:get-instance-by-value
1156	'd:ItemIdentifierC 'd:uri
1157	"http://www.isidor.us/unittests/testtm")
1158	:revision 0))
1159	:item-type-p nil :parent-p nil :instance-of-p nil :revision 0)
1160	",\"associations\":"
1161	(jtm::export-associations-to-jtm
1162	(d:associations
1163	(d:identified-construct
1164	(elephant:get-instance-by-value
1165	'd:ItemIdentifierC 'd:uri
1166	"http://www.isidor.us/unittests/testtm")
1167	:revision 0))
1168	:item-type-p nil :parent-p nil :revision 0)
1169	",\"item_type\":\"topicmap\",\"reifier\":null}")))))))
1170
1171
1172	(test test-import-jtm-references-1
1173	"Tests all functions that are responsible for processing and searching
1174	constructs by jtm-references."
1175	(with-fixture with-empty-db ("data_base")
1176	(let ((prefixes (list (list :pref "pref_1" :value "http://pref.org/")
1177	(list :pref "pref_3" :value "http://pref.org/app/")
1178	(list :pref "pref_2" :value "http://pref.org/app#"))))
1179	(is (string= (jtm::compute-full-uri prefixes "pref_1" "suffix-1")
1180	"http://pref.org/suffix-1"))
1181	(is (string= (jtm::compute-full-uri prefixes "pref_3" "suffix-2")
1182	"http://pref.org/app/suffix-2"))
1183	(is (string= (jtm::compute-full-uri prefixes "pref_2" "suffix-3")
1184	"http://pref.org/app#suffix-3"))
1185	(signals exceptions:jtm-error
1186	(jtm::compute-full-uri prefixes "pref_4" "suffix-3"))
1187	(signals exceptions:jtm-error
1188	(jtm::compute-full-uri prefixes "pref_1" ""))
1189	(is (eql (jtm::get-identifier-type-from-jtm-reference "ii:[pref:suff]")
1190	'ItemIdentifierC))
1191	(is (eql (jtm::get-identifier-type-from-jtm-reference "si:http://pref.suf")
1192	'PersistentIdC))
1193	(is (eql (jtm::get-identifier-type-from-jtm-reference "sl:")
1194	'SubjectLocatorC))
1195	(signals exceptions::JTM-error
1196	(jtm::get-identifier-type-from-jtm-reference "xy:[pref:suff]"))
1197	(signals exceptions::JTM-error
1198	(jtm::get-identifier-type-from-jtm-reference "ii[pref:suff]"))
1199	(signals exceptions::JTM-error
1200	(jtm::get-identifier-type-from-jtm-reference ""))
1201	(is (string= (jtm::compute-uri-from-jtm-identifier "http://any.uri" nil)
1202	"http://any.uri"))
1203	(is (string=
1204	(jtm::compute-uri-from-jtm-identifier "http://any.uri" prefixes)
1205	"http://any.uri"))
1206	(is (string=
1207	(jtm::compute-uri-from-jtm-identifier "pref_1:any.uri" prefixes)
1208	"pref_1:any.uri"))
1209	(is (string=
1210	(jtm::compute-uri-from-jtm-identifier "[pref_1:any.uri]" prefixes)
1211	"http://pref.org/any.uri"))
1212	(signals exceptions::JTM-error
1213	(jtm::compute-uri-from-jtm-identifier "[pref_5:any.uri]" prefixes))
1214	(signals exceptions::JTM-error
1215	(jtm::compute-uri-from-jtm-identifier "" prefixes))
1216	(signals exceptions::JTM-error
1217	(jtm::compute-uri-from-jtm-identifier "[]" prefixes))
1218	(signals exceptions::JTM-error
1219	(jtm::compute-uri-from-jtm-identifier "[any.uri]" prefixes))
1220	(signals exceptions::JTM-error
1221	(jtm::compute-uri-from-jtm-identifier "[pref:]" prefixes))
1222	(signals exceptions::JTM-error
1223	(jtm::compute-uri-from-jtm-identifier "[:suffix]" prefixes))
1224	(is (string=
1225	(jtm::compute-uri-from-jtm-identifier "[http://any.uri" prefixes)
1226	"[http://any.uri"))
1227	(is (string=
1228	(jtm::compute-uri-from-jtm-identifier "http://any.uri]" prefixes)
1229	"http://any.uri]")))))
1230
1231
1232	(test test-import-jtm-references-2
1233	"Tests all functions that are responsible for processing and searching
1234	constructs by jtm-references."
1235	(with-fixture with-empty-db ("data_base")
1236	(let ((prefixes (list (list :pref "pref_1" :value "http://pref.org/")
1237	(list :pref "pref_3" :value "http://pref.org/app/")
1238	(list :pref "pref_2" :value "http://pref.org/app#")))
1239	(top-1 (make-construct 'TopicC :start-revision 100
1240	:psis
1241	(list (make-construct
1242	'PersistentIdC
1243	:uri "http://pref.org/app#psi-1")
1244	(make-construct
1245	'PersistentIdC
1246	:uri "http://pref.org/app/psi-1"))
1247	:item-identifiers
1248	(list (make-construct
1249	'ItemIdentifierC
1250	:uri "http://pref.org/iis/ii-1"))
1251	:locators
1252	(list (make-construct
1253	'SubjectLocatorC
1254	:uri "http://some.where/app/sl-1"))))
1255	(assoc-1 (make-construct 'AssociationC :start-revision 100
1256	:item-identifiers
1257	(list (make-construct
1258	'ItemIdentifierC
1259	:uri "http://pref.org/app#ii-2")))))
1260	(is (eql (jtm::get-item-from-jtm-reference
1261	"si:http://pref.org/app#psi-1" :revision 0 :prefixes prefixes)
1262	top-1))
1263	(is (eql (jtm::get-item-from-jtm-reference
1264	"si:[pref_2:psi-1]" :revision 0 :prefixes prefixes)
1265	top-1))
1266	(is (eql (jtm::get-item-from-jtm-reference
1267	"si:[pref_3:psi-1]" :revision 0 :prefixes prefixes)
1268	top-1))
1269	(is (eql (jtm::get-item-from-jtm-reference
1270	"si:[pref_1:app#psi-1]" :revision 0 :prefixes prefixes)
1271	top-1))
1272	(signals exceptions::missing-reference-error
1273	(jtm::get-item-from-jtm-reference
1274	"sl:http://pref.org/app/sl-1" :revision 0))
1275	(is (eql (jtm::get-item-from-jtm-reference
1276	"sl:http://some.where/app/sl-1" :revision 0)
1277	top-1))
1278	(is (eql (jtm::get-item-from-jtm-reference
1279	"ii:http://pref.org/iis/ii-1" :revision 0 :prefixes prefixes)
1280	top-1))
1281	(is (eql (jtm::get-item-from-jtm-reference
1282	"ii:[pref_1:iis/ii-1]" :revision 0 :prefixes prefixes)
1283	top-1))
1284	(signals exceptions::jtm-error
1285	(jtm::get-item-from-jtm-reference
1286	"ii:[pref_1:iis/ii-1]" :revision 0))
1287	(signals exceptions::missing-reference-error
1288	(jtm::get-item-from-jtm-reference
1289	"si:[pref_1:iis/ii-1]" :revision 0 :prefixes prefixes))
1290	(is (eql (jtm::get-item-from-jtm-reference
1291	"ii:http://pref.org/app#ii-2" :revision 0 :prefixes prefixes)
1292	assoc-1))
1293	(is (eql (jtm::get-item-from-jtm-reference
1294	"ii:[pref_2:ii-2]" :revision 0 :prefixes prefixes)
1295	assoc-1))
1296	(let ((refs (jtm::get-items-from-jtm-references
1297	(list "si:http://pref.org/app#psi-1"
1298	"si:[pref_2:psi-1]"
1299	"sl:http://some.where/app/sl-1"
1300	"ii:http://pref.org/iis/ii-1"
1301	"ii:http://pref.org/app#ii-2"
1302	"ii:[pref_2:ii-2]")
1303	:revision 0 :prefixes prefixes)))
1304	(dotimes (idx 3)
1305	(is (eql (elt refs idx) top-1)))
1306	(dotimes (idx 2)
1307	(is (eql (elt refs (+ idx 4)) assoc-1)))))))
1308
1309
1310	(test test-get-item
1311	"Tests the function get-item."
1312	(let* ((jtm-variant "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"http://some.where/ii-1\",\"[pref_1:ii-2]\"],\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}")
1313	(jtm-lst (json:decode-json-from-string jtm-variant)))
1314	(is (string= (jtm::get-item :VERSION jtm-lst) "1.1"))
1315	(is-false (set-exclusive-or (jtm::get-item :ITEM--IDENTIFIERS jtm-lst)
1316	(list "http://some.where/ii-1"
1317	"[pref_1:ii-2]") :test #'string=))
1318	(is (eql (first (first (jtm::get-item :PREFIXES jtm-lst))) :XSD))
1319	(is (string= (rest (first (jtm::get-item :PREFIXES jtm-lst)))
1320	"http://www.w3.org/2001/XMLSchema#"))
1321	(is (eql (first (second (jtm::get-item :PREFIXES jtm-lst))) :PREF--1))
1322	(is (string= (rest (second (jtm::get-item :PREFIXES jtm-lst)))
1323	"http://some.where/"))))
1324
1325
1326	(test test-import-identifiers
1327	"Tests the functions import-identifier-from-jtm-string and
1328	import-identifiers-from-jtm-strings."
1329	(with-fixture with-empty-db ("data_base")
1330	(let* ((prefixes (list (list :pref "pref_1" :value "http://pref.org/")
1331	(list :pref "pref_2" :value "http://pref.org#")
1332	(list :pref "pref_3" :value "http://pref.org/app/")))
1333	(j-ii-1 "http://pref.org/ii-1")
1334	(j-ii-2 "[pref_1:ii-2]")
1335	(j-sl-1 "[pref_2:sl-1]")
1336	(j-sl-2 "[pref_3:app_2/sl-2]")
1337	(j-psi-1 "[pref_3:psi-1]")
1338	(j-psi-2 "http://pref.org/psi-2")
1339	(ii-1 (jtm::import-identifier-from-jtm-string j-ii-1 :prefixes prefixes))
1340	(sl-1 (jtm::import-identifier-from-jtm-string
1341	j-sl-1 :prefixes prefixes :identifier-type-symbol 'SubjectLocatorC))
1342	(psi-1 (jtm::import-identifier-from-jtm-string
1343	j-psi-1 :prefixes prefixes :identifier-type-symbol 'PersistentIdC))
1344	(psi-2 (jtm::import-identifier-from-jtm-string
1345	j-psi-2 :prefixes prefixes :identifier-type-symbol 'PersistentIdC))
1346	(psis (jtm::import-identifiers-from-jtm-strings
1347	(list j-psi-1 j-psi-2) :prefixes prefixes
1348	:identifier-type-symbol 'PersistentIdC))
1349	(iis (jtm::import-identifiers-from-jtm-strings (list j-ii-1 j-ii-2)
1350	:prefixes prefixes))
1351	(ii-2 (elephant:get-instance-by-value
1352	'd:ItemIdentifierC 'd:uri "http://pref.org/ii-2"))
1353	(sls (jtm::import-identifiers-from-jtm-strings
1354	(list j-sl-1 j-sl-2) :prefixes prefixes
1355	:identifier-type-symbol 'SubjectLocatorC))
1356	(sl-2 (elephant:get-instance-by-value
1357	'd:SubjectLocatorC 'd:uri "http://pref.org/app/app_2/sl-2")))
1358	(signals exceptions:JTM-error
1359	(jtm::import-identifier-from-jtm-string j-ii-2))
1360	(signals exceptions:duplicate-identifier-error
1361	(jtm::import-identifier-from-jtm-string
1362	j-ii-1 :identifier-type-symbol 'PersistentIdC))
1363	(signals exceptions:JTM-error
1364	(jtm::import-identifiers-from-jtm-strings (list j-ii-2)))
1365	(signals exceptions:duplicate-identifier-error
1366	(jtm::import-identifiers-from-jtm-strings
1367	(list j-ii-1) :identifier-type-symbol 'PersistentIdC))
1368	(is (eql (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri j-ii-1)
1369	ii-1))
1370	(is (find ii-2 iis))
1371	(is (eql (elephant:get-instance-by-value
1372	'd:SubjectLocatorC 'd:uri "http://pref.org#sl-1")
1373	sl-1))
1374	(is (find sl-2 sls))
1375	(is (eql (elephant:get-instance-by-value
1376	'd:PersistentIdC 'd:uri "http://pref.org/app/psi-1")
1377	psi-1))
1378	(is (eql (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri j-psi-2)
1379	psi-2))
1380	(is-false (set-exclusive-or psis (list psi-1 psi-2)))
1381	(is-false (set-exclusive-or iis (list ii-1 ii-2)))
1382	(is-false (set-exclusive-or sls (list sl-1 sl-2))))))
1383
1384
1385	(test test-import-variants
1386	"Tests the functions import-variant-from-jtm-string and
1387	import-characteristics-from-jtm-strings."
1388	(with-fixture with-empty-db ("data_base")
1389	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
1390	(list :pref "pref_1" :value "http://some.where/")))
1391	(jtm-var-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-string) ",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}"))
1392	(jtm-var-2 (concat "{\"version\":\"1.0\",\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-3\"],\"datatype\":" (json:encode-json-to-string xml-uri) ",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"variant\",\"scope\":[\"sl:http:\\/\\/some.where\\/sl-1\"],\"reifier\":\"ii:http:\\/\\/some.where\\/ii-2\"}"))
1393	(jtm-var-3 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-string) ",\"value\":\"var-1\",\"item_type\":\"variant\",\"parent\":[\"ii:[pref_1:ii-10]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":null}"))
1394	(name-1 (make-construct
1395	'NameC :start-revision 100
1396	:item-identifiers
1397	(list (make-construct 'ItemIdentifierC
1398	:uri "http://some.where/ii-1"))))
1399	(scope-1 (make-construct
1400	'TopicC :start-revision 100
1401	:psis
1402	(list (make-construct 'PersistentIdC
1403	:uri "http://some.where/psi-1"))))
1404	(var-1 (jtm::import-variant-from-jtm-list
1405	(json:decode-json-from-string jtm-var-1) nil :revision 100
1406	:prefixes prefixes))
1407	(scope-2 (make-construct
1408	'TopicC :start-revision 100
1409	:locators
1410	(list (make-construct 'SubjectLocatorC
1411	:uri "http://some.where/sl-1"))))
1412	(reifier-2 (make-construct
1413	'TopicC :start-revision 100
1414	:item-identifiers
1415	(list (make-construct 'ItemIdentifierC
1416	:uri "http://some.where/ii-2"))))
1417	(var-2 (jtm::import-variant-from-jtm-list
1418	(json:decode-json-from-string jtm-var-2) name-1 :revision 100
1419	:prefixes prefixes))
1420	(vars (jtm::import-characteristics-from-jtm-lists
1421	(list (json:decode-json-from-string jtm-var-1)
1422	(json:decode-json-from-string jtm-var-2)) name-1
1423	#'jtm::import-variant-from-jtm-list :revision 100
1424	:prefixes prefixes)))
1425	(is-true (d:find-item-by-revision var-1 100 name-1))
1426	(is-false (d:find-item-by-revision var-1 50 name-1))
1427	(is (eql (parent var-1 :revision 0) name-1))
1428	(is (eql (parent var-2 :revision 0) name-1))
1429	(is (string= (datatype var-1) xml-string))
1430	(is (string= (datatype var-2) xml-uri))
1431	(is (string= (charvalue var-1) "var-1"))
1432	(is (string= (charvalue var-2) "http://any.uri"))
1433	(is-false (d:item-identifiers var-1 :revision 0))
1434	(is-false (set-exclusive-or
1435	(map 'list #'d:uri (d:item-identifiers var-2 :revision 0))
1436	(list "http://some.where/ii-3") :test #'string=))
1437	(is-false (reifier var-1 :revision 0))
1438	(is (eql (reifier var-2 :revision 0) reifier-2))
1439	(is-false (set-exclusive-or (themes var-1 :revision 0) (list scope-1)))
1440	(is-false (set-exclusive-or (themes var-2 :revision 0) (list scope-2)))
1441	(is-false (set-exclusive-or vars (list var-1 var-2)))
1442	(signals exceptions:missing-reference-error
1443	(jtm::import-variant-from-jtm-list
1444	(json:decode-json-from-string jtm-var-3) nil :revision 100
1445	:prefixes prefixes))
1446	(signals exceptions:JTM-error
1447	(jtm::import-variant-from-jtm-list
1448	(json:decode-json-from-string jtm-var-1) name-1 :revision 100))
1449	(signals exceptions:JTM-error
1450	(jtm::import-variant-from-jtm-list
1451	(json:decode-json-from-string jtm-var-2) nil :revision 100))
1452	(signals exceptions:missing-reference-error
1453	(jtm::import-characteristics-from-jtm-lists
1454	(list (json:decode-json-from-string jtm-var-3)) nil
1455	#'jtm::import-variant-from-jtm-list :revision 100
1456	:prefixes prefixes))
1457	(signals exceptions:JTM-error
1458	(jtm::import-characteristics-from-jtm-lists
1459	(list (json:decode-json-from-string jtm-var-1)) name-1
1460	#'jtm::import-variant-from-jtm-list :revision 100))
1461	(signals exceptions:JTM-error
1462	(jtm::import-characteristics-from-jtm-lists
1463	(list (json:decode-json-from-string jtm-var-2)) nil
1464	#'jtm::import-variant-from-jtm-list :revision 100)))))
1465
1466
1467	(test test-import-occurrences
1468	"Tests the functions import-occurrence-from-jtm-string and
1469	import-characteristics-from-jtm-strings."
1470	(with-fixture with-empty-db ("data_base")
1471	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
1472	(list :pref "pref_1" :value "http://some.where/")))
1473	(jtm-occ-1 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-2]\"],\"datatype\":" (json:encode-json-to-string xml-string ) ",\"type\":\"sl:[pref_1:sl-1]\",\"value\":\"occ-1\",\"item_type\":\"occurrence\",\"parent\":[\"si:[pref_1:psi-1]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":\"ii:[pref_1:ii-1]\"}"))
1474	(jtm-occ-2 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-uri ) ",\"type\":\"si:http:\\/\\/some.where\\/psi-1\",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}"))
1475	(jtm-occ-3 (concat "{\"version\":\"1.1\",\"prefixes\":{\"xsd\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#\",\"pref_1\":\"http:\\/\\/some.where\\/\"},\"item_identifiers\":[\"[pref_1:ii-2]\"],\"datatype\":" (json:encode-json-to-string xml-string ) ",\"type\":\"sl:[pref_1:sl-1]\",\"value\":\"occ-1\",\"item_type\":\"occurrence\",\"parent\":[\"si:[pref_1:psi-6]\"],\"scope\":[\"si:[pref_1:psi-1]\"],\"reifier\":\"ii:[pref_1:ii-1]\"}"))
1476	(jtm-occ-4 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-uri ) ",\"type\":null,\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}"))
1477	(jtm-occ-5 (concat "{\"version\":\"1.0\",\"item_identifiers\":null,\"datatype\":" (json:encode-json-to-string xml-uri ) ",\"type\":\"si:http://any-uri/psi-10\",\"value\":\"http:\\/\\/any.uri\",\"item_type\":\"occurrence\",\"scope\":null,\"reifier\":null}"))
1478	(type-1 (make-construct
1479	'TopicC :start-revision 0
1480	:locators
1481	(list (make-construct 'SubjectLocatorC
1482	:uri "http://some.where/sl-1"))))
1483	(scope-1 (make-construct
1484	'TopicC :start-revision 0
1485	:psis
1486	(list (make-construct 'PersistentIdC
1487	:uri "http://some.where/psi-1"))))
1488	(reifier-1 (make-construct
1489	'TopicC :start-revision 0
1490	:item-identifiers
1491	(list (make-construct 'ItemIdentifierC
1492	:uri "http://some.where/ii-1"))))
1493	(parent-1 scope-1)
1494	(type-2 scope-1)
1495	(occ-1 (jtm::import-occurrence-from-jtm-list
1496	(json:decode-json-from-string jtm-occ-1) nil :revision 100
1497	:prefixes prefixes))
1498	(occ-2 (jtm::import-occurrence-from-jtm-list
1499	(json:decode-json-from-string jtm-occ-2) parent-1 :revision 100
1500	:prefixes prefixes))
1501	(occs (jtm::import-characteristics-from-jtm-lists
1502	(list (json:decode-json-from-string jtm-occ-1)
1503	(json:decode-json-from-string jtm-occ-2)) parent-1
1504	#'jtm::import-occurrence-from-jtm-list :revision 100
1505	:prefixes prefixes)))
1506	(is-true (d:find-item-by-revision occ-1 100 parent-1))
1507	(is-false (d:find-item-by-revision occ-1 50 parent-1))
1508	(is (eql (parent occ-1 :revision 0) parent-1))
1509	(is (eql (parent occ-2 :revision 0) parent-1))
1510	(is (string= (datatype occ-1) xml-string))
1511	(is (string= (datatype occ-2) xml-uri))
1512	(is (string= (charvalue occ-1) "occ-1"))
1513	(is (string= (charvalue occ-2) "http://any.uri"))
1514	(is-false (set-exclusive-or
1515	(map 'list #'d:uri (d:item-identifiers occ-1 :revision 0))
1516	(list "http://some.where/ii-2") :test #'string=))
1517	(is-false (d:item-identifiers occ-2 :revision 0))
1518	(is (eql (reifier occ-1 :revision 0) reifier-1))
1519	(is-false (reifier occ-2 :revision 0))
1520	(is-false (set-exclusive-or (themes occ-1 :revision 0) (list scope-1)))
1521	(is-false (themes occ-2 :revision 0))
1522	(is (eql (instance-of occ-1 :revision 0) type-1))
1523	(is (eql (instance-of occ-2 :revision 0) type-2))
1524	(is-false (set-exclusive-or (list occ-1 occ-2) occs))
1525	(signals exceptions:missing-reference-error
1526	(jtm::import-occurrence-from-jtm-list
1527	(json:decode-json-from-string jtm-occ-5) parent-1 :revision 100
1528	:prefixes prefixes))
1529	(signals exceptions:JTM-error
1530	(jtm::import-occurrence-from-jtm-list
1531	(json:decode-json-from-string jtm-occ-4) parent-1 :revision 100
1532	:prefixes prefixes))
1533	(signals exceptions:missing-reference-error
1534	(jtm::import-occurrence-from-jtm-list
1535	(json:decode-json-from-string jtm-occ-3) nil :revision 100
1536	:prefixes prefixes))
1537	(signals exceptions:JTM-error
1538	(jtm::import-occurrence-from-jtm-list
1539	(json:decode-json-from-string jtm-occ-1) parent-1 :revision 100))
1540	(signals exceptions:JTM-error
1541	(jtm::import-occurrence-from-jtm-list
1542	(json:decode-json-from-string jtm-occ-2) nil :revision 100))
1543	(signals exceptions:missing-reference-error
1544	(jtm::import-characteristics-from-jtm-lists
1545	(list (json:decode-json-from-string jtm-occ-3)) nil
1546	#'jtm::import-occurrence-from-jtm-list :revision 100
1547	:prefixes prefixes))
1548	(signals exceptions:JTM-error
1549	(jtm::import-characteristics-from-jtm-lists
1550	(list (json:decode-json-from-string jtm-occ-1)) parent-1
1551	#'jtm::import-occurrence-from-jtm-list :revision 100))
1552	(signals exceptions:JTM-error
1553	(jtm::import-characteristics-from-jtm-lists
1554	(list (json:decode-json-from-string jtm-occ-2)) nil
1555	#'jtm::import-occurrence-from-jtm-list :revision 100)))))
1556
1557
1558	(test test-import-names
1559	"Tests the functions import-name-from-jtm-list and
1560	import-characteristics-from-jtm-lists."
1561	(with-fixture with-empty-db ("data_base")
1562	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
1563	(list :pref "pref_1" :value xsd-ns)
1564	(list :pref "pref_2" :value "http://some.where/")))
1565	(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]\"}"))
1566	(jtm-name-2 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"scope\":null,\"variants\":null,\"reifier\":null}")
1567	(jtm-name-3 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"parent\":[\"si:[pref_2:psi-10]\"],\"scope\":null,\"variants\":null,\"reifier\":null}")
1568	(type-1 (make-construct
1569	'TopicC :start-revision 100
1570	:locators
1571	(list (make-construct 'SubjectLocatorC
1572	:uri "http://some.where/sl-1"))))
1573	(type-2 (make-construct
1574	'TopicC :start-revision 100
1575	:psis
1576	(list (make-construct 'PersistentIdC
1577	:uri topic-name-psi))))
1578	(parent-1 (make-construct
1579	'TopicC :start-revision 100
1580	:psis
1581	(list (make-construct 'PersistentIdC
1582	:uri "http://some.where/psi-1"))))
1583	(scope-1 parent-1)
1584	(reifier-1 (make-construct
1585	'TopicC :start-revision 100
1586	:item-identifiers
1587	(list (make-construct 'ItemIdentifierC
1588	:uri "http://some.where/ii-1"))))
1589	(name-1 (jtm::import-name-from-jtm-list
1590	(json:decode-json-from-string jtm-name-1) nil :revision 100
1591	:prefixes prefixes))
1592	(name-2 (jtm::import-name-from-jtm-list
1593	(json:decode-json-from-string jtm-name-2) parent-1 :revision 100
1594	:prefixes prefixes))
1595	(names (jtm::import-characteristics-from-jtm-lists
1596	(list (json:decode-json-from-string jtm-name-1)
1597	(json:decode-json-from-string jtm-name-2)) parent-1
1598	#'jtm::import-name-from-jtm-list :revision 100
1599	:prefixes prefixes)))
1600	(is-true (d:find-item-by-revision name-1 100 parent-1))
1601	(is-false (d:find-item-by-revision name-1 50 parent-1))
1602	(is (eql (parent name-1 :revision 0) parent-1))
1603	(is (eql (parent name-2 :revision 0) parent-1))
1604	(is (string= (charvalue name-1) "name-1"))
1605	(is (string= (charvalue name-2) "name-2"))
1606	(is-false (set-exclusive-or
1607	(map 'list #'d:uri (d:item-identifiers name-1 :revision 0))
1608	(list "http://some.where/ii-2") :test #'string=))
1609	(is-false (d:item-identifiers name-2 :revision 0))
1610	(is (eql (reifier name-1 :revision 0) reifier-1))
1611	(is-false (reifier name-2 :revision 0))
1612	(is-false (set-exclusive-or (themes name-1 :revision 0) (list scope-1)))
1613	(is-false (themes name-2 :revision 0))
1614	(is (eql (instance-of name-1 :revision 0) type-1))
1615	(is (eql (instance-of name-2 :revision 0) type-2))
1616	(is-false (set-exclusive-or
1617	(map 'list #'d:charvalue (variants name-1 :revision 0))
1618	(list "var-1" "var-2") :test #'string=))
1619	(is-false (variants name-2 :revision 0))
1620	(is-false (set-exclusive-or names (list name-1 name-2)))
1621	(signals exceptions:missing-reference-error
1622	(jtm::import-name-from-jtm-list
1623	(json:decode-json-from-string jtm-name-3) nil :revision 100
1624	:prefixes prefixes))
1625	(signals exceptions:JTM-error
1626	(jtm::import-name-from-jtm-list
1627	(json:decode-json-from-string jtm-name-1) parent-1 :revision 100))
1628	(signals exceptions:JTM-error
1629	(jtm::import-name-from-jtm-list
1630	(json:decode-json-from-string jtm-name-2) nil :revision 100))
1631	(signals exceptions:missing-reference-error
1632	(jtm::import-characteristics-from-jtm-lists
1633	(list (json:decode-json-from-string jtm-name-3)) nil
1634	#'jtm::import-name-from-jtm-list :revision 100
1635	:prefixes prefixes))
1636	(signals exceptions:JTM-error
1637	(jtm::import-characteristics-from-jtm-lists
1638	(list (json:decode-json-from-string jtm-name-1)) parent-1
1639	#'jtm::import-name-from-jtm-list :revision 100))
1640	(signals exceptions:JTM-error
1641	(jtm::import-characteristics-from-jtm-lists
1642	(list (json:decode-json-from-string jtm-name-2)) nil
1643	#'jtm::import-name-from-jtm-list :revision 100)))))
1644
1645
1646	(test test-make-instance-of-association
1647	"Tests the function make-instance-of-association."1
1648	(with-fixture with-empty-db ("data_base")
1649	(let* ((tt (make-construct 'TopicC :start-revision 100
1650	:psis
1651	(list (make-construct 'PersistentIdC
1652	:uri type-psi))))
1653	(it (make-construct 'TopicC :start-revision 100
1654	:psis
1655	(list (make-construct 'PersistentIdC
1656	:uri instance-psi))))
1657	(tit (make-construct 'TopicC :start-revision 100
1658	:psis
1659	(list (make-construct 'PersistentIdC
1660	:uri type-instance-psi))))
1661	(top-1 (make-construct
1662	'TopicC :start-revision 100
1663	:psis
1664	(list (make-construct 'PersistentIdC
1665	:uri "http://some.where/psi-1"))))
1666	(top-2 (make-construct
1667	'TopicC :start-revision 100
1668	:locators
1669	(list (make-construct 'SubjectLocatorC
1670	:uri "http://some.where/sl-1"))))
1671	(top-3 (make-construct
1672	'TopicC :start-revision 100
1673	:item-identifiers
1674	(list (make-construct 'ItemIdentifierC
1675	:uri "http://some.where/ii-1"))))
1676	(tm (make-construct
1677	'TopicMapC :start-revision 100
1678	:item-identifiers
1679	(list (make-construct 'ItemIdentifierC
1680	:uri "http://some.where/tm-ii")))))
1681	(jtm::make-instance-of-association top-1 top-2 (list tm) :revision 100)
1682	(is (= (length (player-in-roles top-1 :revision 0)) 1))
1683	(is (eql (instance-of (first (player-in-roles top-1 :revision 0)) :revision 0)
1684	it))
1685	(let ((assoc (parent (first (player-in-roles top-1 :revision 0)) :revision 0)))
1686	(is-true assoc)
1687	(is (= (length (roles assoc :revision 0)) 2))
1688	(is (eql (instance-of assoc :revision 0) tit))
1689	(is-true (find tm (in-topicmaps assoc :revision 0)))
1690	(is-true (find-if #'(lambda(role)
1691	(and (eql (instance-of role :revision 0) tt)
1692	(eql (player role :revision 0) top-2)))
1693	(roles assoc :revision 0))))
1694	(is (= (length (player-in-roles top-2 :revision 0)) 1))
1695	(is-true (find tm (in-topicmaps tt :revision 0)))
1696	(is-false (find tm (in-topicmaps tt :revision 50)))
1697	(is-true (find tm (in-topicmaps it :revision 0)))
1698	(is-true (find tm (in-topicmaps tit :revision 0)))
1699	(jtm::make-instance-of-association top-2 top-3 (list tm) :revision 100)
1700	(is (= (length (player-in-roles top-2 :revision 0)) 2))
1701	(is (= (length (player-in-roles top-3 :revision 0)) 1))
1702	(is (eql (instance-of (first (player-in-roles top-3 :revision 0)) :revision 0)
1703	tt))
1704	(let ((assoc (parent (first (player-in-roles top-3 :revision 0)) :revision 0)))
1705	(is-true assoc)
1706	(is (= (length (roles assoc :revision 0)) 2))
1707	(is (eql (instance-of assoc :revision 0) tit))
1708	(is-true (find tm (in-topicmaps assoc :revision 0)))
1709	(is-true (find-if #'(lambda(role)
1710	(and (eql (instance-of role :revision 0) it)
1711	(eql (player role :revision 0) top-2)))
1712	(roles assoc :revision 0))))
1713	(signals exceptions:JTM-error
1714	(jtm::make-instance-of-association top-1 top-3 nil :revision 100))
1715	(delete-psi
1716	tt (elephant:get-instance-by-value 'PersistentIdc 'd:uri type-psi)
1717	:revision 200)
1718	(signals exceptions:missing-reference-error
1719	(jtm::make-instance-of-association top-1 top-3 (list tm) :revision 200)))))
1720
1721
1722	(test test-import-topics
1723	"Tests the functions import-topic-stub-from-jtm-list,
1724	and import-topic-stubs-from-jtm-lists."
1725	(with-fixture with-empty-db ("data_base")
1726	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
1727	(list :pref "pref_1" :value xsd-ns)
1728	(list :pref "pref_2" :value "http://some.where/")))
1729	(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\":null,\"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}]}")
1730	(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}]}")
1731	(j-top-3 "{\"subject_identifiers\":[\"http:\\/\\/some.where\\/tmsparql\\/author\"],\"subject_locators\":null,\"item_identifiers\":null,\"names\":null,\"occurrences\":null}")
1732	(j-top-4 "{\"subject_identifiers\":[\"http:\\/\\/some.where\\/tmsparql\\/first-name\"],\"subject_locators\":null,\"item_identifiers\":null,\"names\":null,\"occurrences\":null}")
1733	(j-top-5 "{\"subject_identifiers\":null,\"subject_locators\":null,\"item_identifiers\":[\"http:\\/\\/some.where\\/ii\\/goethe-name-reifier\"],\"names\":null,\"occurrences\":null}")
1734	(tm-1 (make-construct
1735	'TopicMapC :start-revision 100
1736	:item-identifiers
1737	(list (make-construct 'ItemIdentifierC
1738	:uri "http://some.where/tm-1"))))
1739	(tm-2 (make-construct
1740	'TopicMapC :start-revision 100
1741	:item-identifiers
1742	(list (make-construct 'ItemIdentifierC
1743	:uri "http://some.where/tm-2")))))
1744	(is-false (elephant:get-instances-by-class 'd:TopicC))
1745	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 2))
1746	(let ((top-1 (jtm::import-topic-stub-from-jtm-list
1747	(json:decode-json-from-string j-top-1)
1748	(list tm-1 tm-2) :revision 100 :prefixes prefixes)))
1749	(is (= (length (elephant:get-instances-by-class 'TopicC)) 1))
1750	(is-false (elephant:get-instances-by-class 'NameC))
1751	(is-false (elephant:get-instances-by-class 'VariantC))
1752	(is-false (elephant:get-instances-by-class 'RoleC))
1753	(is-false (elephant:get-instances-by-class 'AssociationC))
1754	(is-false (elephant:get-instances-by-class 'OccurrenceC))
1755	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 2))
1756	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3))
1757	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1))
1758	(is-false (set-exclusive-or (list "http://some.where/psi-1"
1759	"http://some.where/psi-2")
1760	(map 'list #'d:uri (psis top-1 :revision 0))
1761	:test #'string=))
1762	(is-false (set-exclusive-or
1763	(list "http://some.where/sl-2")
1764	(map 'list #'d:uri (locators top-1 :revision 0))
1765	:test #'string=))
1766	(is-false (set-exclusive-or
1767	(list "http://some.where/ii-4")
1768	(map 'list #'d:uri (item-identifiers top-1 :revision 0))
1769	:test #'string=))
1770	(is-true (find tm-1 (in-topicmaps top-1 :revision 0)))
1771	(is-true (find tm-2 (in-topicmaps top-1 :revision 0))))
1772	(let ((top-2 (jtm::import-topic-stub-from-jtm-list
1773	(json:decode-json-from-string j-top-2)
1774	(list tm-1 tm-2) :revision 200)))
1775	(is (= (length (elephant:get-instances-by-class 'TopicC)) 1))
1776	(is-false (elephant:get-instances-by-class 'NameC))
1777	(is-false (elephant:get-instances-by-class 'VariantC))
1778	(is-false (elephant:get-instances-by-class 'RoleC))
1779	(is-false (elephant:get-instances-by-class 'AssociationC))
1780	(is-false (elephant:get-instances-by-class 'OccurrenceC))
1781	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 2))
1782	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 3))
1783	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1))
1784	(is-false (set-exclusive-or (list "http://some.where/psi-1"
1785	"http://some.where/psi-2")
1786	(map 'list #'d:uri (psis top-2 :revision 200))
1787	:test #'string=))
1788	(is-false (set-exclusive-or
1789	(list "http://some.where/sl-2")
1790	(map 'list #'d:uri (locators top-2 :revision 200))
1791	:test #'string=))
1792	(is-false (set-exclusive-or
1793	(list "http://some.where/ii-4")
1794	(map 'list #'d:uri (item-identifiers top-2 :revision 200))
1795	:test #'string=))
1796	(is-true (find tm-1 (in-topicmaps top-2 :revision 200)))
1797	(is-true (find tm-2 (in-topicmaps top-2 :revision 200))))
1798	(let ((tops-3-4-5
1799	(jtm::import-topic-stubs-from-jtm-lists
1800	(list (json:decode-json-from-string j-top-3)
1801	(json:decode-json-from-string j-top-4)
1802	(json:decode-json-from-string j-top-5))
1803	(list tm-1 tm-2) :revision 200)))
1804	(is (= (length tops-3-4-5) 3))
1805	(is (= (length (elephant:get-instances-by-class 'TopicC)) 4))
1806	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 4))
1807	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 4))
1808	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 1))
1809	(is-false (elephant:get-instances-by-class 'NameC))
1810	(is-false (elephant:get-instances-by-class 'VariantC))
1811	(is-false (elephant:get-instances-by-class 'RoleC))
1812	(is-false (elephant:get-instances-by-class 'AssociationC))
1813	(is-false (elephant:get-instances-by-class 'OccurrenceC))
1814	(is-true (find-if #'(lambda(top)
1815	(and (= (length (psis top :revision 0)) 1)
1816	(not (item-identifiers top :revision 0))
1817	(not (locators top :revision 0))
1818	(string= (uri (first (psis top :revision 0)))
1819	"http://some.where/tmsparql/author")))
1820	tops-3-4-5))
1821	(is-true
1822	(find-if #'(lambda(top)
1823	(and (= (length (psis top :revision 0)) 1)
1824	(not (item-identifiers top :revision 0))
1825	(not (locators top :revision 0))
1826	(string= (uri (first (psis top :revision 0)))
1827	"http://some.where/tmsparql/first-name")))
1828	tops-3-4-5))
1829	(is-true
1830	(find-if #'(lambda(top)
1831	(and (= (length (item-identifiers top :revision 0)) 1)
1832	(not (psis top :revision 0))
1833	(not (locators top :revision 0))
1834	(string= (uri (first (item-identifiers top :revision 0)))
1835	"http://some.where/ii/goethe-name-reifier")))
1836	tops-3-4-5))
1837	(signals exceptions:jtm-error
1838	(jtm::import-topic-stub-from-jtm-list
1839	(json:decode-json-from-string j-top-1)
1840	(list tm-1 tm-2) :revision 200))
1841	(signals exceptions:missing-reference-error
1842	(jtm::import-topic-stub-from-jtm-list
1843	(json:decode-json-from-string j-top-2)
1844	nil :revision 200))
1845	(signals exceptions:jtm-error
1846	(jtm::import-topic-stubs-from-jtm-lists
1847	(list (json:decode-json-from-string j-top-1))
1848	(list tm-1 tm-2) :revision 200))
1849	(signals exceptions:missing-reference-error
1850	(jtm::import-topic-stubs-from-jtm-lists
1851	(list (json:decode-json-from-string j-top-2))
1852	nil :revision 200))))))
1853
1854
1855	(test test-merge-topics
1856	"Tests the functions import-topic-stub-from-jtm-list,
1857	and import-topic-stubs-from-jtm-lists."
1858	(with-fixture with-empty-db ("data_base")
1859	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
1860	(list :pref "pref_1" :value xsd-ns)
1861	(list :pref "pref_2" :value "http://some.where/")))
1862	(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}]}")
1863	(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}]}")
1864	(j-top-3 "{\"subject_identifiers\":[\"http:\\/\\/some.where\\/tmsparql\\/author\"],\"subject_locators\":null,\"item_identifiers\":null,\"names\":null,\"occurrences\":null}")
1865	(j-top-4 "{\"subject_identifiers\":null,\"subject_locators\":[\"http:\\/\\/some.where\\/sl-1\"],\"item_identifiers\":null,\"names\":null,\"occurrences\":null}")
1866	(j-top-5 "{\"subject_identifiers\":null,\"subject_locators\":null,\"item_identifiers\":[\"http:\\/\\/some.where\\/ii-1\"],\"names\":null,\"occurrences\":null}")
1867	(tm-1 (make-construct
1868	'TopicMapC :start-revision 100
1869	:item-identifiers
1870	(list (make-construct 'ItemIdentifierC
1871	:uri "http://some.where/tm-1"))))
1872	(topic-name (make-construct
1873	'TopicC :start-revision 100
1874	:psis
1875	(list (make-construct 'PersistentIdC
1876	:uri topic-name-psi))))
1877	(tm-2 (make-construct
1878	'TopicMapC :start-revision 100
1879	:item-identifiers
1880	(list (make-construct 'ItemIdentifierC
1881	:uri "http://some.where/tm-2"))))
1882	(tops (jtm::import-topic-stubs-from-jtm-lists
1883	(list (json:decode-json-from-string j-top-1)
1884	(json:decode-json-from-string j-top-2)
1885	(json:decode-json-from-string j-top-3)
1886	(json:decode-json-from-string j-top-4)
1887	(json:decode-json-from-string j-top-5))
1888	(list tm-1 tm-2) :revision 100 :prefixes prefixes)))
1889	(is (= (length tops) 5))
1890	(is (= (length (remove-duplicates tops)) 4))
1891	(is (= (length (elephant:get-instances-by-class 'TopicC)) 5))
1892	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 4))
1893	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 4))
1894	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
1895	(is-false (elephant:get-instances-by-class 'NameC))
1896	(is-false (elephant:get-instances-by-class 'VariantC))
1897	(is-false (elephant:get-instances-by-class 'RoleC))
1898	(is-false (elephant:get-instances-by-class 'AssociationC))
1899	(is-false (elephant:get-instances-by-class 'OccurrenceC))
1900	(signals exceptions:missing-reference-error ;missing topics for
1901	(jtm::merge-topic-from-jtm-list ;type-instance-associations
1902	(json:decode-json-from-string j-top-1)
1903	(list tm-1 tm-2) :revision 100 :prefixes prefixes))
1904	(make-construct 'TopicC :start-revision 100
1905	:psis
1906	(list (make-construct 'PersistentIdC
1907	:uri type-psi)))
1908	(make-construct 'TopicC :start-revision 100
1909	:psis
1910	(list (make-construct 'PersistentIdC
1911	:uri instance-psi)))
1912	(make-construct 'TopicC :start-revision 100
1913	:psis
1914	(list (make-construct 'PersistentIdC
1915	:uri type-instance-psi)))
1916	(let ((top-1 (jtm::merge-topic-from-jtm-list
1917	(json:decode-json-from-string j-top-1)
1918	(list tm-1 tm-2) :revision 100 :prefixes prefixes))
1919	(top-2 (jtm::merge-topic-from-jtm-list
1920	(json:decode-json-from-string j-top-2)
1921	(list tm-1 tm-2) :revision 100 :prefixes prefixes)))
1922	(is (= (length (elephant:get-instances-by-class 'TopicC)) 8))
1923	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7))
1924	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5))
1925	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
1926	(is (= (length (elephant:get-instances-by-class 'NameC)) 2))
1927	(is (= (length (elephant:get-instances-by-class 'VariantC)) 1))
1928	(is (= (length (elephant:get-instances-by-class 'RoleC)) 2))
1929	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
1930	(is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 2))
1931	(is (eql top-1 top-2))
1932	(is (= (length (names top-1 :revision 0)) 2))
1933	(is-true (find-if #'(lambda(name)
1934	(and (string= (charvalue name) "name-1")
1935	(eql (instance-of name :revision 0)
1936	topic-name)
1937	(not (themes name :revision 0))
1938	(not (variants name :revision 0))
1939	(not (reifier name :revision 0))
1940	(not (item-identifiers name :revision 0))))
1941	(names top-1 :revision 0)))
1942	(is-true
1943	(find-if #'(lambda(name)
1944	(and (string= (charvalue name) "name-2")
1945	(eql (instance-of name :revision 0)
1946	topic-name)
1947	(= (length (themes name :revision 0)) 1)
1948	(= (length (locators (first (themes name :revision 0))
1949	:revision 0)) 1)
1950	(string=
1951	(uri (first (locators (first (themes name :revision 0))
1952	:revision 0)))
1953	"http://some.where/sl-1")
1954	(= (length (variants name :revision 0)) 1)
1955	(not (reifier name :revision 0))
1956	(not (item-identifiers name :revision 0))))
1957	(names top-1 :revision 0)))
1958	(is-true
1959	(find-if #'(lambda(occ)
1960	(and (string= (charvalue occ) "occ-1")
1961	(string= (datatype occ) xml-string)
1962	(instance-of occ :revision 0)
1963	(= (length (locators (instance-of occ :revision 0)
1964	:revision 0)) 1)
1965	(string=
1966	(uri (first (locators (instance-of occ :revision 0)
1967	:revision 0)))
1968	"http://some.where/sl-1")
1969	(= (length (themes occ :revision 0)) 1)
1970	(= (length (psis (first (themes occ :revision 0))
1971	:revision 0)) 2)
1972	(or (string=
1973	(uri (first (psis (first (themes occ :revision 0))
1974	:revision 0)))
1975	"http://some.where/psi-1")
1976	(string=
1977	(uri (second (psis (first (themes occ :revision 0))
1978	:revision 0)))
1979	"http://some.where/psi-1"))
1980	(reifier occ :revision 0)
1981	(= (length (item-identifiers occ :revision 0)) 1)
1982	(string= (uri (first (item-identifiers occ :revision 0)))
1983	"http://some.where/ii-2")))
1984	(occurrences top-1 :revision 0)))
1985	(is-true
1986	(find-if #'(lambda(occ)
1987	(and (string= (charvalue occ) "http://any.uri")
1988	(string= (datatype occ) xml-uri)
1989	(instance-of occ :revision 0)
1990	(or (string=
1991	(uri (first (psis (instance-of occ :revision 0)
1992	:revision 0)))
1993	"http://some.where/psi-1")
1994	(string=
1995	(uri (second (psis (instance-of occ :revision 0)
1996	:revision 0)))
1997	"http://some.where/psi-1"))
1998	(not (themes occ :revision 0))
1999	(not (reifier occ :revision 0))
2000	(not (item-identifiers occ :revision 0))))
2001	(occurrences top-1 :revision 0))))
2002	(let ((tops (jtm::merge-topics-from-jtm-lists
2003	(list (json:decode-json-from-string j-top-1)
2004	(json:decode-json-from-string j-top-2)
2005	(json:decode-json-from-string j-top-3)
2006	(json:decode-json-from-string j-top-4)
2007	(json:decode-json-from-string j-top-5))
2008	(list tm-1 tm-2) :revision 200 :prefixes prefixes)))
2009	(is (= (length (remove-duplicates tops)) 4))
2010	(is (= (length (elephant:get-instances-by-class 'TopicC)) 8))
2011	(is (= (length (elephant:get-instances-by-class 'PersistentIdC)) 7))
2012	(is (= (length (elephant:get-instances-by-class 'ItemIdentifierC)) 5))
2013	(is (= (length (elephant:get-instances-by-class 'SubjectLocatorC)) 2))
2014	(is (= (length (elephant:get-instances-by-class 'NameC)) 2))
2015	(is (= (length (elephant:get-instances-by-class 'VariantC)) 1))
2016	(is (= (length (elephant:get-instances-by-class 'RoleC)) 2))
2017	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
2018	(is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 2)))
2019	(signals exceptions:jtm-error
2020	(jtm::merge-topic-from-jtm-list
2021	(json:decode-json-from-string j-top-1)
2022	(list tm-1 tm-2) :revision 200))
2023	(signals exceptions:jtm-error
2024	(jtm::merge-topic-from-jtm-list
2025	(json:decode-json-from-string j-top-1)
2026	(list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil))
2027	(signals exceptions:JTM-error
2028	(jtm::merge-topic-from-jtm-list
2029	(json:decode-json-from-string j-top-1)
2030	nil :revision 200 :prefixes prefixes))
2031	(signals exceptions:jtm-error
2032	(jtm::merge-topics-from-jtm-lists
2033	(list (json:decode-json-from-string j-top-1))
2034	(list tm-1 tm-2) :revision 200))
2035	(signals exceptions:jtm-error
2036	(jtm::merge-topics-from-jtm-lists
2037	(list (json:decode-json-from-string j-top-1))
2038	(list tm-1 tm-2) :revision 200 :prefixes prefixes :instance-of-p nil))
2039	(signals exceptions:JTM-error
2040	(jtm::merge-topics-from-jtm-lists
2041	(list (json:decode-json-from-string j-top-1))
2042	nil :revision 200 :prefixes prefixes)))))
2043
2044
2045	(test test-import-associations
2046	"Tests the functions import-association-from-jtm-list."
2047	(with-fixture with-empty-db ("data_base")
2048	(let* ((prefixes
2049	(list (list :pref "pref_3"
2050	:value "http://psi.topicmaps.org/iso13250/model/")
2051	(list :pref "xsd" :value xsd-ns)
2052	(list :pref "pref_1" :value xsd-ns)
2053	(list :pref "pref_2" :value "http://some.where/")))
2054	(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\"}]}")
2055	(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]\"}]}")
2056	(goethe (make-construct
2057	'TopicC :start-revision 100
2058	:psis
2059	(list (make-construct
2060	'PersistentIdC
2061	:uri "http://some.where/tmsparql/author/goethe"))))
2062	(zauberlehrling (make-construct
2063	'TopicC :start-revision 100
2064	:psis
2065	(list (make-construct
2066	'PersistentIdC
2067	:uri "http://some.where/psis/poem/zauberlehrling"))))
2068	(author (make-construct
2069	'TopicC :start-revision 100
2070	:psis
2071	(list (make-construct
2072	'PersistentIdC
2073	:uri "http://some.where/tmsparql/author"))))
2074	(tt (make-construct
2075	'TopicC :start-revision 100
2076	:psis (list (make-construct 'PersistentIdC
2077	:uri type-psi))))
2078	(it (make-construct
2079	'TopicC :start-revision 100
2080	:psis (list (make-construct 'PersistentIdC
2081	:uri instance-psi))))
2082	(tit (make-construct
2083	'TopicC :start-revision 100
2084	:psis (list (make-construct 'PersistentIdC
2085	:uri type-instance-psi))))
2086	(written-by (make-construct
2087	'TopicC :start-revision 100
2088	:psis
2089	(list (make-construct
2090	'PersistentIdC
2091	:uri "http://some.where/tmsparql/written-by"))))
2092	(writer (make-construct
2093	'TopicC :start-revision 100
2094	:psis
2095	(list (make-construct
2096	'PersistentIdC
2097	:uri "http://some.where/tmsparql/writer"))))
2098	(written (make-construct
2099	'TopicC :start-revision 100
2100	:psis
2101	(list (make-construct
2102	'PersistentIdC
2103	:uri "http://some.where/tmsparql/written"))))
2104	(reifier-assoc-1 (make-construct
2105	'TopicC :start-revision 100
2106	:item-identifiers
2107	(list (make-construct
2108	'ItemIdentifierC
2109	:uri "http://some.where/ii/association-reifier"))))
2110	(reifier-role-1-1 (make-construct
2111	'TopicC :start-revision 100
2112	:item-identifiers
2113	(list (make-construct
2114	'ItemIdentifierC
2115	:uri "http://some.where/ii/role-reifier"))))
2116	(scope-2 (make-construct
2117	'TopicC :start-revision 100
2118	:psis
2119	(list (make-construct
2120	'PersistentIdC
2121	:uri "http://some.where/my-scope"))))
2122	(tm (make-construct 'TopicMapC :start-revision 100
2123	:item-idenitfiers
2124	(list (make-construct 'ItemIdentifierC
2125	:uri "http://some.where/tm")))))
2126	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
2127	(let ((assoc-1 (jtm::import-association-from-jtm-list
2128	(json:decode-json-from-string j-assoc-1)
2129	(list tm) :revision 100)))
2130	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
2131	(is (= (length (elephant:get-instances-by-class 'RoleC)) 2))
2132	(is (eql (instance-of assoc-1 :revision 0) written-by))
2133	(is-false (set-exclusive-or
2134	(list "http://some.where/ii/association")
2135	(map 'list #'d:uri (item-identifiers assoc-1 :revision 0))
2136	:test #'string=))
2137	(is (eql (reifier assoc-1 :revision 0) reifier-assoc-1))
2138	(is-true (find tm (in-topicmaps assoc-1 :revision 0)))
2139	(is-false (themes assoc-1 :revision 0))
2140	(= (length (roles assoc-1 :revision 0)) 2)
2141	(is-true (find-if #'(lambda(role)
2142	(and (eql (instance-of role :revision 0) writer)
2143	(eql (player role :revision 0) goethe)
2144	(not (item-identifiers role :revision 0))
2145	(eql (reifier role :revision 0)
2146	reifier-role-1-1)))
2147	(roles assoc-1 :revision 0)))
2148	(is-true
2149	(find-if #'(lambda(role)
2150	(and (eql (instance-of role :revision 0) written)
2151	(eql (player role :revision 0) zauberlehrling)
2152	(= (length (item-identifiers role :revision 0)) 1)
2153	(string=
2154	"http://some.where/ii/role-2"
2155	(uri (first (item-identifiers role :revision 0))))
2156	(not (reifier role :revision 0))))
2157	(roles assoc-1 :revision 0)))
2158	(is (= (length (player-in-roles goethe :revision 0)) 1))
2159	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
2160	(is (= (length (player-in-roles author :revision 0)) 0)))
2161	(let ((assoc-2 (jtm::import-association-from-jtm-list
2162	(json:decode-json-from-string j-assoc-2)
2163	(list tm) :revision 100 :prefixes prefixes)))
2164	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 2))
2165	(is (= (length (elephant:get-instances-by-class 'RoleC)) 4))
2166	(is (eql (instance-of assoc-2 :revision 0) tit))
2167	(is-false (item-identifiers assoc-2 :revision 0))
2168	(is-false (reifier assoc-2 :revision 0))
2169	(is-true (find tm (in-topicmaps assoc-2 :revision 0)))
2170	(is (= (length (themes assoc-2 :revision 0)) 1))
2171	(is (eql (first (themes assoc-2 :revision 0)) scope-2))
2172	(= (length (roles assoc-2 :revision 0)) 2)
2173	(is-true (find-if #'(lambda(role)
2174	(and (eql (instance-of role :revision 0) tt)
2175	(eql (player role :revision 0) author)
2176	(not (item-identifiers role :revision 0))
2177	(not (reifier role :revision 0))))
2178	(roles assoc-2 :revision 0)))
2179	(is-true
2180	(find-if #'(lambda(role)
2181	(and (eql (instance-of role :revision 0) it)
2182	(eql (player role :revision 0) goethe)
2183	(not (item-identifiers role :revision 0))
2184	(not (reifier role :revision 0))))
2185	(roles assoc-2 :revision 0)))
2186	(is (= (length (player-in-roles goethe :revision 0)) 2))
2187	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
2188	(is (= (length (player-in-roles author :revision 0)) 1)))
2189	(let ((assocs (jtm::import-associations-from-jtm-lists
2190	(list (json:decode-json-from-string j-assoc-1)
2191	(json:decode-json-from-string j-assoc-2))
2192	(list tm) :revision 200 :prefixes prefixes)))
2193	(is (= (length assocs) 2))
2194	(is (= (length (player-in-roles goethe :revision 0)) 2))
2195	(is (= (length (player-in-roles zauberlehrling :revision 0)) 1))
2196	(is (= (length (player-in-roles author :revision 0)) 1)))
2197	(signals exceptions::JTM-error
2198	(jtm::import-association-from-jtm-list
2199	(json:decode-json-from-string j-assoc-1)
2200	nil :revision 100))
2201	(signals exceptions::JTM-error
2202	(jtm::import-association-from-jtm-list
2203	(json:decode-json-from-string j-assoc-2)
2204	nil :revision 100))
2205	(signals exceptions::JTM-error
2206	(jtm::import-association-from-jtm-list
2207	(json:decode-json-from-string
2208	"{\"item_identifiers\":null,\"type\":\"si:http:\\/\\/some.where\\/tmsparql\\/written-by\",\"reifier\":null,\"scope\":null,\"roles\":null}")
2209	(list tm) :revision 100))
2210	(signals exceptions::JTM-error
2211	(jtm::import-association-from-jtm-list
2212	(json:decode-json-from-string
2213	"{\"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\"}]}")
2214	(list tm) :revision 100))
2215	(signals exceptions::JTM-error
2216	(jtm::import-associations-from-jtm-lists
2217	(list (json:decode-json-from-string j-assoc-1))
2218	nil :revision 100))
2219	(signals exceptions::JTM-error
2220	(jtm::import-associations-from-jtm-lists
2221	(list (json:decode-json-from-string j-assoc-2))
2222	nil :revision 100)))))
2223
2224
2225	(test test-import-roles
2226	"Tests the function import-role-from-jtm-list."
2227	(with-fixture with-empty-db ("data_base")
2228	(let* ((prefixes (list (list :pref "xsd" :value xsd-ns)
2229	(list :pref "pref_1" :value "http://some.where/")))
2230	(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]\"}")
2231	(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\"}")
2232	(type-1 (make-construct
2233	'TopicC :start-revision 100
2234	:locators
2235	(list (make-construct 'SubjectLocatorC
2236	:uri "http://some.where/sl-1"))))
2237	(reifier-1 (make-construct
2238	'TopicC :start-revision 100
2239	:locators
2240	(list (make-construct 'SubjectLocatorC
2241	:uri "http://some.where/sl-2"))))
2242	(parent-1 (make-construct
2243	'AssociationC :start-revision 100
2244	:item-identifiers
2245	(list (make-construct 'ItemIdentifierC
2246	:uri "http://some.where/ii-2"))))
2247	(player-1 (make-construct
2248	'TopicC :start-revision 100
2249	:psis
2250	(list (make-construct 'PersistentIdC
2251	:uri "http://some.where/psi-1"))))
2252	(type-2 (make-construct
2253	'TopicC :start-revision 100
2254	:item-identifiers
2255	(list (make-construct 'ItemIdentifierC
2256	:uri "http://some.where/ii-1"))))
2257	(player-2 type-1)
2258	(role-1 (jtm::import-role-from-jtm-list
2259	(json:decode-json-from-string jtm-role-1)
2260	nil :revision 100 :prefixes prefixes))
2261	(role-2 (jtm::import-role-from-jtm-list
2262	(json:decode-json-from-string jtm-role-2)
2263	parent-1 :revision 100)))
2264	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
2265	(is (= (length (elephant:get-instances-by-class 'RoleC)) 2))
2266	(is (= (length (roles parent-1 :revision 0)) 2))
2267	(map 'list #'(lambda(role)
2268	(is (eql (parent role :revision 0) parent-1)))
2269	(elephant:get-instances-by-class 'RoleC))
2270	(is-true (find-if #'(lambda(role)
2271	(and
2272	(eql (instance-of role :revision 0) type-1)
2273	(eql (player role :revision 0) player-1)
2274	(eql (reifier role :revision 0) reifier-1)
2275	(= (length (item-identifiers role :revision 0)) 2)
2276	(or (string=
2277	(uri (first (item-identifiers role :revision 0)))
2278	"http://some.where/ii-3")
2279	(string=
2280	(uri (second (item-identifiers role :revision 0)))
2281	"http://some.where/ii-3"))
2282	(or (string=
2283	(uri (first (item-identifiers role :revision 0)))
2284	"http://some.where/ii-4")
2285	(string=
2286	(uri (second (item-identifiers role :revision 0)))
2287	"http://some.where/ii-4"))))
2288	(roles parent-1 :revision 0)))
2289	(is-true (find-if #'(lambda(role)
2290	(and
2291	(eql (instance-of role :revision 0) type-2)
2292	(eql (player role :revision 0) player-2)
2293	(not (reifier role :revision 0))
2294	(not (item-identifiers role :revision 0))))
2295	(roles parent-1 :revision 0)))
2296	(is-true (find role-1 (roles parent-1 :revision 0)))
2297	(is-true (find role-2 (roles parent-1 :revision 0)))
2298	(signals exceptions::JTM-error
2299	(jtm::import-role-from-jtm-list
2300	(json:decode-json-from-string jtm-role-1)
2301	nil :revision 100))
2302	(signals exceptions::JTM-error
2303	(jtm::import-role-from-jtm-list
2304	(json:decode-json-from-string jtm-role-2)
2305	nil :revision 100))
2306	(signals exceptions::JTM-error
2307	(jtm::import-role-from-jtm-list
2308	(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}")
2309	parent-1 :revision 100))
2310	(signals exceptions::JTM-error
2311	(jtm::import-role-from-jtm-list
2312	(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\"}")
2313	parent-1 :revision 100)))))
2314
2315
2316	(test test-import-topic-maps-1
2317	"Tests the function import-topic-map-from-jtm-list."
2318	(with-fixture with-empty-db ("data_base")
2319	(let ((jtm-str
2320	(read-file-to-string
2321	(merge-pathnames
2322	(asdf:component-pathname
2323	(asdf:find-component constants:isidorus-system "unit_tests"))
2324	"jtm_1.1_test.jtm"))))
2325	(make-construct 'TopicC :start-revision 100
2326	:psis
2327	(list (make-construct 'PersistentIdC
2328	:uri topic-name-psi)))
2329	(let ((tm (import-construct-from-jtm-string
2330	jtm-str :revision 100 :jtm-format :1.1)))
2331	(is-true tm)
2332	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
2333	(loop for top in (elephant:get-instances-by-class 'TopicC) do
2334	(cond ((and
2335	(= (length (psis top :revision 0)) 1)
2336	(find
2337	(uri (first (psis top :revision 0)))
2338	(list
2339	"http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
2340	"http://www.topicmaps.org/xtm/1.0/core.xtm#association"
2341	"http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
2342	"http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
2343	"http://www.topicmaps.org/xtm/1.0/core.xtm#class"
2344	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
2345	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
2346	"http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
2347	"http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
2348	"http://www.topicmaps.org/xtm/1.0/core.xtm#display")
2349	:test #'string=))
2350	(is-false (used-as-theme top :revision 0))
2351	(is-false (used-as-type top :revision 0))
2352	(is-false (player-in-roles top :revision 0))
2353	(is-false (reified-construct top :revision 0))
2354	(is-false (occurrences top :revision 0))
2355	(is-false (names top :revision 0))
2356	(is-false (item-identifiers top :revision 0))
2357	(is-false (locators top :revision 0))
2358	(is (= (length (in-topicmaps top :revision 0)) 1))
2359	(is (eql tm (first (in-topicmaps top :revision 0)))))
2360	((and
2361	(= (length (psis top :revision 0)) 1)
2362	(string= (uri (first (psis top :revision 0)))
2363	"http://psi.topicmaps.org/iso13250/model/topic-name"))
2364	(is-false (used-as-theme top :revision 0))
2365	(is-true (used-as-type top :revision 0))
2366	(is-false (player-in-roles top :revision 0))
2367	(is-false (reified-construct top :revision 0))
2368	(is-false (occurrences top :revision 0))
2369	(is-false (names top :revision 0))
2370	(is-false (item-identifiers top :revision 0))
2371	(is-false (locators top :revision 0))
2372	(is-false (in-topicmaps top :revision 0)))
2373	((and
2374	(= (length (psis top :revision 0)) 1)
2375	(find (uri (first (psis top :revision 0)))
2376	(list "http://psi.topicmaps.org/iso13250/model/type-instance"
2377	"http://psi.topicmaps.org/iso13250/model/type"
2378	"http://psi.topicmaps.org/iso13250/model/instance")
2379	:test #'string=))
2380	(is-false (used-as-theme top :revision 0))
2381	(is (= (length (used-as-type top :revision 0)) 29))
2382	(is-false (player-in-roles top :revision 0))
2383	(is-false (reified-construct top :revision 0))
2384	(is-false (occurrences top :revision 0))
2385	(is-false (names top :revision 0))
2386	(is-false (item-identifiers top :revision 0))
2387	(is-false (locators top :revision 0))
2388	(is (= (length (in-topicmaps top :revision 0)) 1))
2389	(is (eql tm (first (in-topicmaps top :revision 0)))))
2390	((and
2391	(= (length (psis top :revision 0)) 1)
2392	(find
2393	(uri (first (psis top :revision 0)))
2394	(list
2395	"http://some.where/tmsparql/written-by"
2396	"http://some.where/tmsparql/written"
2397	"http://some.where/tmsparql/writer"
2398	"http://some.where/tmsparql/first-name"
2399	"http://some.where/tmsparql/last-name"
2400	"http://some.where/tmsparql/title"
2401	"http://some.where/tmsparql/date-of-birth"
2402	"http://some.where/tmsparql/date-of-death"
2403	"http://some.where/tmsparql/years"
2404	"http://some.where/tmsparql/isDead"
2405	"http://some.where/tmsparql/isAlive"
2406	"http://some.where/tmsparql/poem-content")
2407	:test 'string=))
2408	(is-false (used-as-theme top :revision 0))
2409	(is-true (used-as-type top :revision 0))
2410	(is (= (length (player-in-roles top :revision 0)) 1))
2411	(is-false (reified-construct top :revision 0))
2412	(is-false (occurrences top :revision 0))
2413	(is-false (names top :revision 0))
2414	(is-false (item-identifiers top :revision 0))
2415	(is-false (locators top :revision 0))
2416	(is (= (length (in-topicmaps top :revision 0)) 1))
2417	(is (eql tm (first (in-topicmaps top :revision 0)))))
2418	((and
2419	(= (length (psis top :revision 0)) 1)
2420	(find
2421	(uri (first (psis top :revision 0)))
2422	(list
2423	"http://psi.topicmaps.org/tmcl/topic-type"
2424	"http://psi.topicmaps.org/tmcl/occurrence-type"
2425	"http://psi.topicmaps.org/tmcl/association-type"
2426	"http://psi.topicmaps.org/tmcl/name-type"
2427	"http://psi.topicmaps.org/tmcl/scope-type"
2428	"http://psi.topicmaps.org/tmcl/role-type")
2429	:test #'string=))
2430	(is-false (used-as-theme top :revision 0))
2431	(is-false (used-as-type top :revision 0))
2432	(is-true (player-in-roles top :revision 0))
2433	(is-false (reified-construct top :revision 0))
2434	(is-false (occurrences top :revision 0))
2435	(is-false (names top :revision 0))
2436	(is-false (item-identifiers top :revision 0))
2437	(is-false (locators top :revision 0))
2438	(is (= (length (in-topicmaps top :revision 0)) 1))
2439	(is (eql tm (first (in-topicmaps top :revision 0)))))
2440	((or (and
2441	(= (length (psis top :revision 0)) 1)
2442	(find
2443	(uri (first (psis top :revision 0)))
2444	(list
2445	"http://some.where/tmsparql/author/goethe"
2446	"http://some.where/tmsparql/author"
2447	"http://some.where/psis/poem/zauberlehrling"
2448	"http://some.where/tmsparql/poem"
2449	"http://some.where/tmsparql/display-name"
2450	"http://some.where/tmsparql/de"
2451	"http://some.where/tmsparql/reifier-type")
2452	:test #'string=))
2453	(and
2454	(= (length (item-identifiers top :revision 0)) 1)
2455	(find
2456	(uri (first (item-identifiers top :revision 0)))
2457	(list
2458	"http://some.where/ii/goethe-occ-reifier"
2459	"http://some.where/ii/goethe-name-reifier"
2460	"http://some.where/ii/association-reifier"
2461	"http://some.where/ii/role-reifier")
2462	:test #'string=)))
2463	nil) ;is checked in the next unit-test
2464	(t
2465	(is-false top))))))))
2466
2467
2468
2469
2470	(test test-import-topic-maps-2
2471	"Tests the function import-topic-map-from-jtm-list."
2472	(with-fixture with-empty-db ("data_base")
2473	(let ((jtm-str
2474	(read-file-to-string
2475	(merge-pathnames
2476	(asdf:component-pathname
2477	(asdf:find-component constants:isidorus-system "unit_tests"))
2478	"jtm_1.1_test.jtm"))))
2479	(make-construct 'TopicC :start-revision 100
2480	:psis
2481	(list (make-construct 'PersistentIdC
2482	:uri topic-name-psi)))
2483	(let ((tm (import-construct-from-jtm-string
2484	jtm-str :revision 100 :jtm-format :1.1)))
2485	(is-true tm)
2486	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
2487	(loop for top in (elephant:get-instances-by-class 'TopicC) do
2488	(cond ((and
2489	(= (length (psis top :revision 0)) 1)
2490	(find
2491	(uri (first (psis top :revision 0)))
2492	(list
2493	"http://psi.topicmaps.org/iso13250/model/topic-name"
2494	"http://psi.topicmaps.org/iso13250/model/type-instance"
2495	"http://psi.topicmaps.org/iso13250/model/type"
2496	"http://psi.topicmaps.org/iso13250/model/instance"
2497	"http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
2498	"http://www.topicmaps.org/xtm/1.0/core.xtm#association"
2499	"http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
2500	"http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
2501	"http://www.topicmaps.org/xtm/1.0/core.xtm#class"
2502	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
2503	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
2504	"http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
2505	"http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
2506	"http://www.topicmaps.org/xtm/1.0/core.xtm#display"
2507	"http://some.where/tmsparql/written-by"
2508	"http://some.where/tmsparql/written"
2509	"http://some.where/tmsparql/writer"
2510	"http://some.where/tmsparql/first-name"
2511	"http://some.where/tmsparql/last-name"
2512	"http://some.where/tmsparql/title"
2513	"http://some.where/tmsparql/date-of-birth"
2514	"http://some.where/tmsparql/date-of-death"
2515	"http://some.where/tmsparql/years"
2516	"http://some.where/tmsparql/isDead"
2517	"http://some.where/tmsparql/isAlive"
2518	"http://some.where/tmsparql/poem-content"
2519	"http://psi.topicmaps.org/tmcl/topic-type"
2520	"http://psi.topicmaps.org/tmcl/occurrence-type"
2521	"http://psi.topicmaps.org/tmcl/association-type"
2522	"http://psi.topicmaps.org/tmcl/name-type"
2523	"http://psi.topicmaps.org/tmcl/scope-type"
2524	"http://psi.topicmaps.org/tmcl/role-type")
2525	:test #'string=))
2526	nil) ;is checked in the unit-test before
2527	((and
2528	(= (length (psis top :revision 0)) 1)
2529	(find
2530	(uri (first (psis top :revision 0)))
2531	(list
2532	"http://some.where/tmsparql/author"
2533	"http://some.where/tmsparql/poem"
2534	"http://some.where/tmsparql/display-name"
2535	"http://some.where/tmsparql/de"
2536	"http://some.where/tmsparql/reifier-type")
2537	:test #'string=))
2538	(is-false (reified-construct top :revision 0))
2539	(is-false (occurrences top :revision 0))
2540	(is-false (names top :revision 0))
2541	(is-false (item-identifiers top :revision 0))
2542	(is-false (locators top :revision 0))
2543	(is (= (length (in-topicmaps top :revision 0)) 1))
2544	(is (eql tm (first (in-topicmaps top :revision 0)))))
2545	((and
2546	(= (length (item-identifiers top :revision 0)) 1)
2547	(find
2548	(uri (first (item-identifiers top :revision 0)))
2549	(list
2550	"http://some.where/ii/goethe-occ-reifier"
2551	"http://some.where/ii/goethe-name-reifier"
2552	"http://some.where/ii/association-reifier"
2553	"http://some.where/ii/role-reifier")
2554	:test #'string=))
2555	(is-false (used-as-theme top :revision 0))
2556	(is-false (used-as-type top :revision 0))
2557	(is-true (player-in-roles top :revision 0))
2558	(is-true (reified-construct top :revision 0))
2559	(is-false (occurrences top :revision 0))
2560	(is-false (names top :revision 0))
2561	(is-false (psis top :revision 0))
2562	(is-false (locators top :revision 0))
2563	(is (= (length (in-topicmaps top :revision 0)) 1))
2564	(is (eql tm (first (in-topicmaps top :revision 0)))))
2565	((and (= (length (psis top :revision 0)) 1)
2566	(string= (uri (first (psis top :revision 0)))
2567	"http://some.where/tmsparql/author/goethe"))
2568	(is-false (used-as-theme top :revision 0))
2569	(is-false (used-as-type top :revision 0))
2570	(is-true (player-in-roles top :revision 0))
2571	(is-false (reified-construct top :revision 0))
2572	(is (= (length (occurrences top :revision 0)) 5))
2573	(is (= (length (names top :revision 0)) 3))
2574	(is (= (length (item-identifiers top :revision 0)) 1))
2575	(is (string=
2576	"http://some.where/ii/goethe"
2577	(uri (first (item-identifiers top :revision 0)))))
2578	(is-false (locators top :revision 0))
2579	(is (= (length (in-topicmaps top :revision 0)) 1))
2580	(is (eql tm (first (in-topicmaps top :revision 0)))))
2581	((and (= (length (psis top :revision 0)) 1)
2582	(string= (uri (first (psis top :revision 0)))
2583	"http://some.where/psis/poem/zauberlehrling"))
2584	(is-false (used-as-theme top :revision 0))
2585	(is-false (used-as-type top :revision 0))
2586	(is-true (player-in-roles top :revision 0))
2587	(is-false (reified-construct top :revision 0))
2588	(is (= (length (occurrences top :revision 0)) 1))
2589	(is (= (length (names top :revision 0)) 1))
2590	(is-false (item-identifiers top :revision 0))
2591	(is-false (locators top :revision 0))
2592	(is (= (length (in-topicmaps top :revision 0)) 1))
2593	(is (eql tm (first (in-topicmaps top :revision 0)))))
2594	(t
2595	(is-false top))))
2596	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
2597	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))
2598	(let ((assoc
2599	(get-item-by-item-identifier "http://some.where/ii/association"
2600	:revision 0)))
2601	(is (typep assoc 'AssociationC))
2602	(is (= (length (roles assoc :revision 0)) 2))
2603	(is (= (length (item-identifiers assoc :revision 0)) 1))
2604	(is (eql (instance-of assoc :revision 0)
2605	(get-item-by-psi "http://some.where/tmsparql/written-by"
2606	:revision 0)))
2607	(is (eql (reifier assoc :revision 0)
2608	(get-item-by-item-identifier
2609	"http://some.where/ii/association-reifier"
2610	:revision 0))))))))
2611
2612
2613	(test test-import-topic-maps-3
2614	"Tests the function import-topic-map-from-jtm-list."
2615	(with-fixture with-empty-db ("data_base")
2616	(let* ((jtm-str
2617	(read-file-to-string
2618	(merge-pathnames
2619	(asdf:component-pathname
2620	(asdf:find-component constants:isidorus-system "unit_tests"))
2621	"jtm_1.0_test.jtm")))
2622	(topic-name
2623	(make-construct 'TopicC :start-revision 100
2624	:psis
2625	(list (make-construct 'PersistentIdC
2626	:uri topic-name-psi))))
2627	(tm (import-construct-from-jtm-string
2628	jtm-str :revision 100 :jtm-format :1.0
2629	:tm-id "http://some.where/jtm-tm")))
2630	(is-true tm)
2631	(is-true topic-name)
2632	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
2633	(loop for top in (elephant:get-instances-by-class 'TopicC) do
2634	(cond ((and
2635	(= (length (psis top :revision 0)) 1)
2636	(find
2637	(uri (first (psis top :revision 0)))
2638	(list
2639	"http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
2640	"http://www.topicmaps.org/xtm/1.0/core.xtm#association"
2641	"http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
2642	"http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
2643	"http://www.topicmaps.org/xtm/1.0/core.xtm#class"
2644	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
2645	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
2646	"http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
2647	"http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
2648	"http://www.topicmaps.org/xtm/1.0/core.xtm#display")
2649	:test #'string=))
2650	(is-false (used-as-theme top :revision 0))
2651	(is-false (used-as-type top :revision 0))
2652	(is-false (player-in-roles top :revision 0))
2653	(is-false (reified-construct top :revision 0))
2654	(is-false (occurrences top :revision 0))
2655	(is-false (names top :revision 0))
2656	(is-false (item-identifiers top :revision 0))
2657	(is-false (locators top :revision 0))
2658	(is (= (length (in-topicmaps top :revision 0)) 1))
2659	(is (eql tm (first (in-topicmaps top :revision 0)))))
2660	((and
2661	(= (length (psis top :revision 0)) 1)
2662	(string= (uri (first (psis top :revision 0)))
2663	"http://psi.topicmaps.org/iso13250/model/topic-name"))
2664	(is-false (used-as-theme top :revision 0))
2665	(is-true (used-as-type top :revision 0))
2666	(is-false (player-in-roles top :revision 0))
2667	(is-false (reified-construct top :revision 0))
2668	(is-false (occurrences top :revision 0))
2669	(is-false (names top :revision 0))
2670	(is-false (item-identifiers top :revision 0))
2671	(is-false (locators top :revision 0))
2672	(is-false (in-topicmaps top :revision 0)))
2673	((and
2674	(= (length (psis top :revision 0)) 1)
2675	(find (uri (first (psis top :revision 0)))
2676	(list "http://psi.topicmaps.org/iso13250/model/type-instance"
2677	"http://psi.topicmaps.org/iso13250/model/type"
2678	"http://psi.topicmaps.org/iso13250/model/instance")
2679	:test #'string=))
2680	(is-false (used-as-theme top :revision 0))
2681	(is (= (length (used-as-type top :revision 0)) 29))
2682	(is-false (player-in-roles top :revision 0))
2683	(is-false (reified-construct top :revision 0))
2684	(is-false (occurrences top :revision 0))
2685	(is-false (names top :revision 0))
2686	(is-false (item-identifiers top :revision 0))
2687	(is-false (locators top :revision 0))
2688	(is (= (length (in-topicmaps top :revision 0)) 1))
2689	(is (eql tm (first (in-topicmaps top :revision 0)))))
2690	((and
2691	(= (length (psis top :revision 0)) 1)
2692	(find
2693	(uri (first (psis top :revision 0)))
2694	(list
2695	"http://some.where/tmsparql/written-by"
2696	"http://some.where/tmsparql/written"
2697	"http://some.where/tmsparql/writer"
2698	"http://some.where/tmsparql/first-name"
2699	"http://some.where/tmsparql/last-name"
2700	"http://some.where/tmsparql/title"
2701	"http://some.where/tmsparql/date-of-birth"
2702	"http://some.where/tmsparql/date-of-death"
2703	"http://some.where/tmsparql/years"
2704	"http://some.where/tmsparql/isDead"
2705	"http://some.where/tmsparql/isAlive"
2706	"http://some.where/tmsparql/poem-content")
2707	:test 'string=))
2708	(is-false (used-as-theme top :revision 0))
2709	(is-true (used-as-type top :revision 0))
2710	(is (= (length (player-in-roles top :revision 0)) 1))
2711	(is-false (reified-construct top :revision 0))
2712	(is-false (occurrences top :revision 0))
2713	(is-false (names top :revision 0))
2714	(is-false (item-identifiers top :revision 0))
2715	(is-false (locators top :revision 0))
2716	(is (= (length (in-topicmaps top :revision 0)) 1))
2717	(is (eql tm (first (in-topicmaps top :revision 0)))))
2718	((and
2719	(= (length (psis top :revision 0)) 1)
2720	(find
2721	(uri (first (psis top :revision 0)))
2722	(list
2723	"http://psi.topicmaps.org/tmcl/topic-type"
2724	"http://psi.topicmaps.org/tmcl/occurrence-type"
2725	"http://psi.topicmaps.org/tmcl/association-type"
2726	"http://psi.topicmaps.org/tmcl/name-type"
2727	"http://psi.topicmaps.org/tmcl/scope-type"
2728	"http://psi.topicmaps.org/tmcl/role-type")
2729	:test #'string=))
2730	(is-false (used-as-theme top :revision 0))
2731	(is-false (used-as-type top :revision 0))
2732	(is-true (player-in-roles top :revision 0))
2733	(is-false (reified-construct top :revision 0))
2734	(is-false (occurrences top :revision 0))
2735	(is-false (names top :revision 0))
2736	(is-false (item-identifiers top :revision 0))
2737	(is-false (locators top :revision 0))
2738	(is (= (length (in-topicmaps top :revision 0)) 1))
2739	(is (eql tm (first (in-topicmaps top :revision 0)))))
2740	((or (and
2741	(= (length (psis top :revision 0)) 1)
2742	(find
2743	(uri (first (psis top :revision 0)))
2744	(list
2745	"http://some.where/tmsparql/author/goethe"
2746	"http://some.where/tmsparql/author"
2747	"http://some.where/psis/poem/zauberlehrling"
2748	"http://some.where/tmsparql/poem"
2749	"http://some.where/tmsparql/display-name"
2750	"http://some.where/tmsparql/de"
2751	"http://some.where/tmsparql/reifier-type")
2752	:test #'string=))
2753	(and
2754	(= (length (item-identifiers top :revision 0)) 1)
2755	(find
2756	(uri (first (item-identifiers top :revision 0)))
2757	(list
2758	"http://some.where/ii/goethe-occ-reifier"
2759	"http://some.where/ii/goethe-name-reifier"
2760	"http://some.where/ii/association-reifier"
2761	"http://some.where/ii/role-reifier")
2762	:test #'string=)))
2763	nil) ;is checked in the next unit-test
2764	(t
2765	(is-false top)))))))
2766
2767
2768	(test test-import-topic-maps-4
2769	"Tests the function import-topic-map-from-jtm-list."
2770	(with-fixture with-empty-db ("data_base")
2771	(let* ((jtm-str
2772	(read-file-to-string
2773	(merge-pathnames
2774	(asdf:component-pathname
2775	(asdf:find-component constants:isidorus-system "unit_tests"))
2776	"jtm_1.0_test.jtm")))
2777	(topic-name
2778	(make-construct 'TopicC :start-revision 100
2779	:psis
2780	(list (make-construct 'PersistentIdC
2781	:uri topic-name-psi))))
2782	(tm (import-construct-from-jtm-string
2783	jtm-str :revision 100 :jtm-format :1.0
2784	:tm-id "http://some.where/jtm-tm")))
2785	(is-true topic-name)
2786	(is-true tm)
2787	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
2788	(loop for top in (elephant:get-instances-by-class 'TopicC) do
2789	(cond ((and
2790	(= (length (psis top :revision 0)) 1)
2791	(find
2792	(uri (first (psis top :revision 0)))
2793	(list
2794	"http://psi.topicmaps.org/iso13250/model/topic-name"
2795	"http://psi.topicmaps.org/iso13250/model/type-instance"
2796	"http://psi.topicmaps.org/iso13250/model/type"
2797	"http://psi.topicmaps.org/iso13250/model/instance"
2798	"http://www.topicmaps.org/xtm/1.0/core.xtm#topic"
2799	"http://www.topicmaps.org/xtm/1.0/core.xtm#association"
2800	"http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence"
2801	"http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance"
2802	"http://www.topicmaps.org/xtm/1.0/core.xtm#class"
2803	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
2804	"http://www.topicmaps.org/xtm/1.0/core.xtm#supertype"
2805	"http://www.topicmaps.org/xtm/1.0/core.xtm#subtype"
2806	"http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
2807	"http://www.topicmaps.org/xtm/1.0/core.xtm#display"
2808	"http://some.where/tmsparql/written-by"
2809	"http://some.where/tmsparql/written"
2810	"http://some.where/tmsparql/writer"
2811	"http://some.where/tmsparql/first-name"
2812	"http://some.where/tmsparql/last-name"
2813	"http://some.where/tmsparql/title"
2814	"http://some.where/tmsparql/date-of-birth"
2815	"http://some.where/tmsparql/date-of-death"
2816	"http://some.where/tmsparql/years"
2817	"http://some.where/tmsparql/isDead"
2818	"http://some.where/tmsparql/isAlive"
2819	"http://some.where/tmsparql/poem-content"
2820	"http://psi.topicmaps.org/tmcl/topic-type"
2821	"http://psi.topicmaps.org/tmcl/occurrence-type"
2822	"http://psi.topicmaps.org/tmcl/association-type"
2823	"http://psi.topicmaps.org/tmcl/name-type"
2824	"http://psi.topicmaps.org/tmcl/scope-type"
2825	"http://psi.topicmaps.org/tmcl/role-type")
2826	:test #'string=))
2827	nil) ;is checked in the unit-test before
2828	((and
2829	(= (length (psis top :revision 0)) 1)
2830	(find
2831	(uri (first (psis top :revision 0)))
2832	(list
2833	"http://some.where/tmsparql/author"
2834	"http://some.where/tmsparql/poem"
2835	"http://some.where/tmsparql/display-name"
2836	"http://some.where/tmsparql/de"
2837	"http://some.where/tmsparql/reifier-type")
2838	:test #'string=))
2839	(is-false (reified-construct top :revision 0))
2840	(is-false (occurrences top :revision 0))
2841	(is-false (names top :revision 0))
2842	(is-false (item-identifiers top :revision 0))
2843	(is-false (locators top :revision 0))
2844	(is (= (length (in-topicmaps top :revision 0)) 1))
2845	(is (eql tm (first (in-topicmaps top :revision 0)))))
2846	((and
2847	(= (length (item-identifiers top :revision 0)) 1)
2848	(find
2849	(uri (first (item-identifiers top :revision 0)))
2850	(list
2851	"http://some.where/ii/goethe-occ-reifier"
2852	"http://some.where/ii/goethe-name-reifier"
2853	"http://some.where/ii/association-reifier"
2854	"http://some.where/ii/role-reifier")
2855	:test #'string=))
2856	(is-false (used-as-theme top :revision 0))
2857	(is-false (used-as-type top :revision 0))
2858	(is-true (player-in-roles top :revision 0))
2859	(is-true (reified-construct top :revision 0))
2860	(is-false (occurrences top :revision 0))
2861	(is-false (names top :revision 0))
2862	(is-false (psis top :revision 0))
2863	(is-false (locators top :revision 0))
2864	(is (= (length (in-topicmaps top :revision 0)) 1))
2865	(is (eql tm (first (in-topicmaps top :revision 0)))))
2866	((and (= (length (psis top :revision 0)) 1)
2867	(string= (uri (first (psis top :revision 0)))
2868	"http://some.where/tmsparql/author/goethe"))
2869	(is-false (used-as-theme top :revision 0))
2870	(is-false (used-as-type top :revision 0))
2871	(is-true (player-in-roles top :revision 0))
2872	(is-false (reified-construct top :revision 0))
2873	(is (= (length (occurrences top :revision 0)) 5))
2874	(is (= (length (names top :revision 0)) 3))
2875	(is (= (length (item-identifiers top :revision 0)) 1))
2876	(is (string=
2877	"http://some.where/ii/goethe"
2878	(uri (first (item-identifiers top :revision 0)))))
2879	(is-false (locators top :revision 0))
2880	(is (= (length (in-topicmaps top :revision 0)) 1))
2881	(is (eql tm (first (in-topicmaps top :revision 0)))))
2882	((and (= (length (psis top :revision 0)) 1)
2883	(string= (uri (first (psis top :revision 0)))
2884	"http://some.where/psis/poem/zauberlehrling"))
2885	(is-false (used-as-theme top :revision 0))
2886	(is-false (used-as-type top :revision 0))
2887	(is-true (player-in-roles top :revision 0))
2888	(is-false (reified-construct top :revision 0))
2889	(is (= (length (occurrences top :revision 0)) 1))
2890	(is (= (length (names top :revision 0)) 1))
2891	(is-false (item-identifiers top :revision 0))
2892	(is-false (locators top :revision 0))
2893	(is (= (length (in-topicmaps top :revision 0)) 1))
2894	(is (eql tm (first (in-topicmaps top :revision 0)))))
2895	(t
2896	(is-false top))))
2897	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))
2898	(let ((assoc
2899	(get-item-by-item-identifier "http://some.where/ii/association"
2900	:revision 0)))
2901	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
2902	(is (typep assoc 'AssociationC))
2903	(is (= (length (roles assoc :revision 0)) 2))
2904	(is (= (length (item-identifiers assoc :revision 0)) 1))
2905	(is (eql (instance-of assoc :revision 0)
2906	(get-item-by-psi "http://some.where/tmsparql/written-by"
2907	:revision 0)))
2908	(is (eql (reifier assoc :revision 0)
2909	(get-item-by-item-identifier
2910	"http://some.where/ii/association-reifier"
2911	:revision 0)))))))
2912
2913
2914	(test test-import-topic-maps-5
2915	"Tests the function import-topic-map-from-jtm-list."
2916	(with-fixture with-empty-db ("data_base")
2917	(let* ((jtm-str-1
2918	(read-file-to-string
2919	(merge-pathnames
2920	(asdf:component-pathname
2921	(asdf:find-component constants:isidorus-system "unit_tests"))
2922	"jtm_1.0_test.jtm")))
2923	(jtm-str-2
2924	(read-file-to-string
2925	(merge-pathnames
2926	(asdf:component-pathname
2927	(asdf:find-component constants:isidorus-system "unit_tests"))
2928	"jtm_1.1_test.jtm"))))
2929	(make-construct 'TopicC :start-revision 100
2930	:psis
2931	(list (make-construct 'PersistentIdC
2932	:uri topic-name-psi)))
2933	(signals exceptions::JTM-error
2934	(import-construct-from-jtm-string
2935	jtm-str-1 :revision 100 :jtm-format :1.1))
2936	(let ((tm (import-construct-from-jtm-string
2937	jtm-str-2 :revision 100 :jtm-format :1.1
2938	:tm-id "http://some.where/new-tm-id")))
2939	(is-false (set-exclusive-or
2940	(list "http://some.where/new-tm-id"
2941	"http://some.where/tmsparql/jtm-tm")
2942	(map 'list #'uri (item-identifiers tm :revision 0))
2943	:test #'string=))
2944	(is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))))))
2945
2946
2947	(test test-import-construct-from-jtm-string
2948	"Tests the function import-construct-from-jtm-string when importing a name."
2949	(with-fixture with-empty-db ("data_base")
2950	(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]\"}"))
2951	(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}")
2952	(jtm-name-3 "{\"version\":\"1.0\",\"item_identifiers\":null,\"value\":\"name-2\",\"type\":null,\"item_type\":\"name\",\"scope\":null,\"variants\":null,\"reifier\":null}")
2953	(type-1 (make-construct
2954	'TopicC :start-revision 100
2955	:locators
2956	(list (make-construct 'SubjectLocatorC
2957	:uri "http://some.where/sl-1"))))
2958	(type-2 (make-construct
2959	'TopicC :start-revision 100
2960	:psis
2961	(list (make-construct 'PersistentIdC
2962	:uri topic-name-psi))))
2963	(parent-1 (make-construct
2964	'TopicC :start-revision 100
2965	:psis
2966	(list (make-construct 'PersistentIdC
2967	:uri "http://some.where/psi-1"))))
2968	(scope-1 parent-1)
2969	(reifier-1 (make-construct
2970	'TopicC :start-revision 100
2971	:item-identifiers
2972	(list (make-construct 'ItemIdentifierC
2973	:uri "http://some.where/ii-1"))))
2974	(name-1 (jtm::import-construct-from-jtm-string
2975	jtm-name-1 :revision 100 :jtm-format :1.1))
2976	(name-2 (jtm::import-construct-from-jtm-string
2977	jtm-name-2 :revision 100 :jtm-format :1.0)))
2978	(is-true (d:find-item-by-revision name-1 100 parent-1))
2979	(is-false (d:find-item-by-revision name-1 50 parent-1))
2980	(is (eql (parent name-1 :revision 0) parent-1))
2981	(is (eql (parent name-2 :revision 0) type-1))
2982	(is (string= (charvalue name-1) "name-1"))
2983	(is (string= (charvalue name-2) "name-2"))
2984	(is-false (set-exclusive-or
2985	(map 'list #'d:uri (d:item-identifiers name-1 :revision 0))
2986	(list "http://some.where/ii-2") :test #'string=))
2987	(is-false (d:item-identifiers name-2 :revision 0))
2988	(is (eql (reifier name-1 :revision 0) reifier-1))
2989	(is-false (reifier name-2 :revision 0))
2990	(is-false (set-exclusive-or (themes name-1 :revision 0) (list scope-1)))
2991	(is-false (themes name-2 :revision 0))
2992	(is (eql (instance-of name-1 :revision 0) type-1))
2993	(is (eql (instance-of name-2 :revision 0) type-2))
2994	(is-false (set-exclusive-or
2995	(map 'list #'d:charvalue (variants name-1 :revision 0))
2996	(list "var-1" "var-2") :test #'string=))
2997	(is-false (variants name-2 :revision 0))
2998	(signals exceptions:JTM-error
2999	(jtm::import-construct-from-jtm-string
3000	jtm-name-3 :revision 100 :jtm-format :1.0))
3001	(signals exceptions:JTM-error
3002	(jtm::import-construct-from-jtm-string
3003	jtm-name-2 :revision 100 :jtm-format :1.1))
3004	(signals exceptions:JTM-error
3005	(jtm::import-construct-from-jtm-string
3006	jtm-name-1 :revision 100 :jtm-format :1.0)))))
3007
3008
3009	(test test-import-from-jtm-1
3010	"Tests the functionimport-from-jtm."
3011	(with-fixture with-empty-db ("data_base")
3012	(make-construct 'TopicC :start-revision 100
3013	:psis
3014	(list (make-construct 'PersistentIdC
3015	:uri topic-name-psi)))
3016	(jtm:import-from-jtm
3017	(merge-pathnames
3018	(asdf:component-pathname
3019	(asdf:find-component constants:isidorus-system "unit_tests"))
3020	"jtm_1.1_test.jtm")
3021	(merge-pathnames
3022	(asdf:component-pathname constants:isidorus-system)
3023	"data_base")
3024	:tm-id "http://some.where/jtm/tm")
3025	(base-tools:open-tm-store
3026	(merge-pathnames
3027	(asdf:component-pathname constants:isidorus-system)
3028	"data_base"))
3029	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
3030	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))))
3031
3032
3033	(test test-import-from-jtm-2
3034	"Tests the functionimport-from-jtm."
3035	(with-fixture with-empty-db ("data_base")
3036	(make-construct 'TopicC :start-revision 100
3037	:psis
3038	(list (make-construct 'PersistentIdC
3039	:uri topic-name-psi)))
3040	(jtm:import-from-jtm
3041	(merge-pathnames
3042	(asdf:component-pathname
3043	(asdf:find-component constants:isidorus-system "unit_tests"))
3044	"jtm_1.0_test.jtm")
3045	(merge-pathnames
3046	(asdf:component-pathname constants:isidorus-system)
3047	"data_base")
3048	:jtm-format :1.0
3049	:tm-id "http://some.where/jtm/tm")
3050	(base-tools:open-tm-store
3051	(merge-pathnames
3052	(asdf:component-pathname constants:isidorus-system)
3053	"data_base"))
3054	(is (= (length (elephant:get-instances-by-class 'TopicC)) 43))
3055	(is (= (length (elephant:get-instances-by-class 'AssociationC)) 30))))
3056
3057
3058	(test test-import-from-jtm-3
3059	"Tests the functionimport-from-jtm."
3060	(with-fixture with-empty-db ("data_base")
3061	(let ((jtm-path-2
3062	(merge-pathnames
3063	(asdf:component-pathname
3064	(asdf:find-component constants:isidorus-system "unit_tests"))
3065	"jtm_1.1_test.jtm"))
3066	(jtm-path-1
3067	(merge-pathnames
3068	(asdf:component-pathname
3069	(asdf:find-component constants:isidorus-system "unit_tests"))
3070	"jtm_1.0_test.jtm"))
3071	(db-path
3072	(merge-pathnames
3073	(asdf:component-pathname constants:isidorus-system)
3074	"data_base")))
3075	(signals exceptions::JTM-error
3076	(jtm:import-from-jtm jtm-path-1 db-path :jtm-format :1.1
3077	:tm-id "http://some.where/tm-id"))
3078	(signals T
3079	(jtm:import-from-jtm jtm-path-1 db-path :jtm-format :1.0))
3080	(signals exceptions::JTM-error
3081	(jtm:import-from-jtm jtm-path-2 db-path :jtm-format :1.0
3082	:tm-id "http://some.where/tm-id")))))
3083
3084	(defun run-jtm-tests()
3085	"Runs all tests of this test-suite."
3086	(it.bese.fiveam:run! 'jtm-tests))

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: branches/gdl-frontend/src/unit_tests/jtm_test.lisp

Download in other formats: