source: trunk/src/unit_tests/jtm_test.lisp

Last change on this file was 470, checked in by lgiessmann, 13 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.