source: trunk/src/unit_tests/reification_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: 42.2 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 :reification-test
11  (:use 
12   :common-lisp
13   :datamodel
14   :it.bese.FiveAM
15   :unittests-constants
16   :fixtures
17   :base-tools
18   :xtm-exporter)
19  (:import-from :constants
20                *xtm2.0-ns*
21                *xtm1.0-ns*
22                *xtm1.0-xlink*
23                *rdf-ns*
24                *rdfs-ns*
25                *type-psi*
26                *instance-psi*
27                *type-instance-psi*
28                *rdf2tm-subject*
29                *rdf2tm-object*)
30  (:import-from :xml-tools
31                xpath-child-elems-by-qname xpath-single-child-elem-by-qname
32                xpath-fn-string)
33  (:export
34   :reification-test
35   :run-reification-tests
36   :test-merge-reifier-topics
37   :test-xtm1.0-reification
38   :test-xtm2.0-reification
39   :test-xtm1.0-reification-exporter
40   :test-xtm2.0-reification-exporter
41   :test-rdf-importer-reification
42   :test-rdf-importer-reification-2
43   :test-rdf-importer-reification-3
44   :test-rdf-importer-reification-4
45   :test-rdf-exporter-reification
46   :test-rdf-exporter-reification-2
47   :test-rdf-exporter-reification-3
48   :test-rdf-exporter-reification-4
49   :test-fragment-reification))
50
51
52(in-package :reification-test)
53
54
55(def-suite reification-test
56     :description "tests various functions of the reification functions")
57
58(in-suite reification-test)
59
60
61(test test-merge-reifier-topics
62  "Tests the function merge-constructs."
63  (let ((db-dir "data_base")
64        (revision-1 100)
65        (revision-2 200))
66    (clean-out-db db-dir)
67    (open-tm-store db-dir)
68    (let ((ii-1-1 (make-instance 'ItemIdentifierC
69                                 :uri "ii-1-1"
70                                 :start-revision revision-1))
71          (ii-1-2 (make-instance 'ItemIdentifierC
72                                 :uri "ii-1-2"
73                                 :start-revision revision-1))
74          (ii-2-1 (make-instance 'ItemIdentifierC
75                                 :uri "ii-2-1"
76                                 :start-revision revision-2))
77          (ii-2-2 (make-instance 'ItemIdentifierC
78                                 :uri "ii-2-2"
79                                 :start-revision revision-2))
80          (psi-1-1 (make-instance 'PersistentIdC
81                                  :uri "psi-1-1"
82                                  :start-revision revision-1))
83          (psi-1-2 (make-instance 'PersistentIdC
84                                  :uri "psi-1-2"
85                                  :start-revision revision-1))
86          (locator-2-1 (make-instance 'SubjectLocatorC
87                                      :uri "locator-2-1"
88                                      :start-revision revision-2))
89          (xtm-id-1 "xtm-id-1")
90          (xtm-id-2 "xtm-id-2")
91          (topic-id-1 "topic-id-1")
92          (topic-id-2 "topic-id-1")) ;should no be merged, since the xtm-id differs
93      (let ((topic-1 (make-construct 'TopicC
94                                     :item-identifiers (list ii-1-1 ii-1-2)
95                                     :locators nil
96                                     :psis (list psi-1-1 psi-1-2)
97                                     :topicid topic-id-1
98                                     :xtm-id xtm-id-1
99                                     :start-revision revision-1))
100            (topic-2 (make-construct 'TopicC
101                                     :item-identifiers (list ii-2-1 ii-2-2)
102                                     :locators (list locator-2-1)
103                                     :psis nil
104                                     :topicid topic-id-2
105                                     :xtm-id xtm-id-2
106                                     :start-revision revision-2))
107            (scope-1 (make-construct 'TopicC
108                                     :psis (list (make-instance 'PersistentIdC
109                                                                :uri "psi-scope-1"
110                                                                :start-revision revision-1))
111                                     :topicid "scope-1"
112                                     :xtm-id xtm-id-1
113                                     :start-revision revision-1))
114            (scope-2 (make-construct 'TopicC
115                                     :psis (list (make-instance 'PersistentIdC
116                                                                :uri "psi-scope-2"
117                                                                :start-revision revision-1))
118                                     :topicid "scope-2"
119                                     :xtm-id xtm-id-1
120                                     :start-revision revision-1))
121            (name-type (make-construct 'TopicC
122                                       :psis (list (make-instance 'PersistentIdC
123                                                                  :uri "psi-name-type"
124                                                                  :start-revision revision-1))
125                                       :topicid "name-type"
126                                       :xtm-id xtm-id-1
127                                       :start-revision revision-1))
128            (assoc-type (make-construct 'TopicC
129                                        :psis (list (make-instance 'PersistentIdC
130                                                                   :uri "psi-assoc-type"
131                                                                   :start-revision revision-1))
132                                       :topicid "assoc-type"
133                                       :xtm-id xtm-id-1
134                                       :start-revision revision-1))
135            (role-type (make-construct 'TopicC
136                                       :psis (list (make-instance 'PersistentIdC
137                                                                  :uri "psi-role-type"
138                                                                  :start-revision revision-1))
139                                       :topicid "assoc-type"
140                                       :xtm-id xtm-id-1
141                                       :start-revision revision-1))
142            (occurrence-type (make-construct 'TopicC
143                                       :psis (list (make-instance 'PersistentIdC
144                                                                  :uri "psi-occurrence-type"
145                                                                  :start-revision revision-1))
146                                       :topicid "occurrence-type"
147                                       :xtm-id xtm-id-1
148                                       :start-revision revision-1)))
149        (let ((name-1-1 (make-construct 'NameC
150                                        :item-identifiers nil
151                                        :parent topic-1
152                                        :themes (list scope-1)
153                                        :instance-of name-type
154                                        :charvalue "name-1-1"
155                                        :start-revision revision-1))
156              (name-2-1 (make-construct 'NameC
157                                        :item-identifiers (list (make-instance 'ItemIdentifierC
158                                                                               :uri "name-2-1-ii-1"
159                                                                               :start-revision revision-1))
160                                        :parent topic-2
161                                        :themes (list scope-2)
162                                        :instance-of nil
163                                        :charvalue "name-2-1"
164                                        :start-revision revision-2))
165              (occurrence-2-1 (make-construct 'OccurrenceC
166                                              :item-identifiers (list (make-instance 'ItemIdentifierC
167                                                                                     :uri "occurrence-1-1-ii-1"
168                                                                                     :start-revision revision-1))
169                                              :parent topic-2
170                                              :themes (list scope-1 scope-2)
171                                              :instance-of occurrence-type
172                                              :charvalue "occurrence-2-1"
173                                              :datatype "datatype"
174                                              :start-revision revision-2))
175              (occurrence-2-2 (make-construct 'OccurrenceC
176                                              :item-identifiers nil
177                                              :parent topic-2
178                                              :themes nil
179                                              :instance-of occurrence-type
180                                              :charvalue "occurrence-2-2"
181                                              :datatype "datatype"
182                                              :start-revision revision-2))
183              (test-name (make-construct 'NameC
184                                         :item-identifiers nil
185                                         :parent scope-2
186                                         :themes (list scope-1 topic-2)
187                                         :instance-of topic-2
188                                         :charvalue "test-name"
189                                         :start-revision revision-2))
190              (assoc (make-construct 'AssociationC
191                                     :item-identifiers nil
192                                     :instance-of assoc-type
193                                     :themes nil
194                                     :roles
195                                     (list 
196                                      (list :instance-of role-type
197                                            :player topic-1
198                                            :start-revision revision-2
199                                            :item-identifiers
200                                            (list (make-instance 'ItemIdentifierC
201                                                                 :uri "role-1"
202                                                                 :start-revision revision-2)))
203                                      (list :instance-of role-type
204                                            :player topic-2
205                                            :start-revision revision-2
206                                            :item-identifiers
207                                            (list (make-instance 'ItemIdentifierC
208                                                                 :uri "role-2"
209                                                                 :start-revision revision-2))))
210                                     :start-revision revision-2)))
211          (is (= (length (elephant:get-instances-by-class 'TopicC)) 8))
212          (d::merge-constructs topic-1 topic-2 :revision revision-2)
213          (is (= (length (elephant:get-instances-by-class 'TopicC)) 7))
214          (is (= (length (union (list ii-1-1 ii-1-2 ii-2-1 ii-2-2)
215                                (item-identifiers topic-1)))
216                 (length (list ii-1-1 ii-1-2 ii-2-1 ii-2-2))))
217          (is (= (length (union (list psi-1-1 psi-1-2)
218                                (psis topic-1)))
219                 (length (list psi-1-1 psi-1-2))))
220          (is (= (length (union (list locator-2-1)
221                                (locators topic-1)))
222                 (length (list locator-2-1))))
223          (is (= (length (union (names topic-1)
224                                (list name-1-1 name-2-1)))
225                 (length (list name-1-1 name-2-1))))
226          (is (= (length (union (occurrences topic-1 :revision 0)
227                                (list occurrence-2-1 occurrence-2-2)))
228                 (length (list occurrence-2-1 occurrence-2-2))))
229          (is (= (length (union (d:used-as-type topic-1)
230                                (list test-name)))
231                 (length (list test-name))))
232          (is (= (length (union (d:used-as-theme topic-1)
233                                (list test-name)))
234                 (length (list test-name))))
235          (is (= (length (roles assoc :revision 0)) 1))
236          (is (= (length (d::slot-p assoc 'd::roles)) 2))
237          (is (eql (player (first (roles assoc :revision 0)) :revision 0) topic-1))
238          (close-tm-store))))))
239
240
241(test test-xtm1.0-reification
242  "Tests the reification in the xtm1.0-importer."
243  (let ((dir "data_base"))
244    (with-fixture initialize-destination-db (dir)
245      (base-tools:open-tm-store "data_base")
246      (make-construct 'TopicC :start-revision 100
247                      :psis
248                      (list (make-construct 'PersistentIdC
249                                            :uri constants:*topic-name-psi*)))
250      (xtm-importer:import-from-xtm
251       *reification_xtm1.0.xtm* dir
252       :tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"
253       :xtm-id "reification-xtm"
254       :xtm-format :1.0)
255      (setf *TM-REVISION* 0)
256      (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
257      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
258      (let ((homer
259             (identified-construct
260              (elephant:get-instance-by-value 'PersistentIdC 'uri "http://simpsons.tv/homer")))
261            (married-assoc
262             (first (elephant:get-instances-by-class 'AssociationC))))
263        (let ((homer-occurrence (first (occurrences homer)))
264              (homer-name (first (names homer)))
265              (homer-variant (first (variants (first (names homer)))))
266              (husband-role (find-if #'(lambda(x)
267                                         (eql (instance-of x)
268                                              (identified-construct
269                                               (elephant:get-instance-by-value
270                                                'PersistentIdC 'uri "http://simpsons.tv/husband"))))
271                                     (roles married-assoc)))
272              (reifier-occurrence
273               (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-occurrence")))
274              (reifier-name
275               (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-name")))
276              (reifier-variant
277               (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#homer-name-variant")))
278              (reifier-married-assoc
279               (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#a-married")))
280              (reifier-husband-role
281               (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri "#married-husband-role"))))
282      (is-true homer)
283      (is-true homer-occurrence)
284      (is-true homer-name)
285      (is-true homer-variant)
286      (is-true married-assoc)
287      (is-true husband-role)
288      (is-true reifier-occurrence)
289      (is-true reifier-name)
290      (is-true reifier-variant)
291      (is-true reifier-married-assoc)
292      (is-true reifier-husband-role)
293      (is (eql (reifier homer-occurrence) reifier-occurrence))
294      (is (eql (reified-construct reifier-occurrence) homer-occurrence))
295      (is (eql (reifier homer-name) reifier-name))
296      (is (eql (reified-construct reifier-name) homer-name))
297      (is (eql (reifier homer-variant) reifier-variant))
298      (is (eql (reified-construct reifier-variant) homer-variant))
299      (is (eql (reifier married-assoc) reifier-married-assoc))
300      (is (eql (reified-construct reifier-married-assoc) married-assoc))
301      (is (eql (reifier husband-role) reifier-husband-role))
302      (is (eql (reified-construct reifier-husband-role) husband-role))
303      (is-true (handler-case 
304                   (progn (d::delete-construct homer-occurrence)
305                          t)
306                 (condition () nil)))
307      (is-false (occurrences homer))
308      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13))
309      (close-tm-store))))))
310
311
312(test test-xtm2.0-reification
313  "Tests the reification in the xtm2.0-importer."
314  (let ((dir "data_base"))
315    (with-fixture initialize-destination-db (dir)
316      (base-tools:open-tm-store "data_base")
317      (make-construct 'TopicC :start-revision 100
318                      :psis
319                      (list (make-construct 'PersistentIdC
320                                            :uri constants:*topic-name-psi*)))
321      (xtm-importer:import-from-xtm
322       *reification_xtm2.0.xtm* dir
323       :tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"
324       :xtm-id "reification-xtm")
325      (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
326      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
327      (setf *TM-REVISION* 0)
328      (let ((homer
329             (identified-construct
330              (elephant:get-instance-by-value 'PersistentIdC 'uri "http://simpsons.tv/homer")))
331            (married-assoc
332             (first (elephant:get-instances-by-class 'AssociationC))))
333        (let ((homer-occurrence (first (occurrences homer)))
334              (homer-name (first (names homer)))
335              (homer-variant (first (variants (first (names homer)))))
336              (husband-role (find-if #'(lambda(x)
337                                         (eql (instance-of x)
338                                              (identified-construct
339                                               (elephant:get-instance-by-value
340                                                'PersistentIdC 'uri "http://simpsons.tv/husband"))))
341                                     (roles married-assoc)))
342              (reifier-occurrence
343               (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/homer-occurrence")))
344              (reifier-name
345               (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/homer-name")))
346              (reifier-variant
347               (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/homer-name-variant")))
348              (reifier-married-assoc
349               (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/married-association")))
350              (reifier-husband-role
351               (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://simpsons.tv/married-husband-role"))))
352      (is-true homer)
353      (is-true homer-occurrence)
354      (is-true homer-name)
355      (is-true homer-variant)
356      (is-true married-assoc)
357      (is-true husband-role)
358      (is-true reifier-occurrence)
359      (is-true reifier-name)
360      (is-true reifier-variant)
361      (is-true reifier-married-assoc)
362      (is-true reifier-husband-role)
363      (is (eql (reifier homer-occurrence) reifier-occurrence))
364      (is (eql (reified-construct reifier-occurrence) homer-occurrence))
365      (is (eql (reifier homer-name) reifier-name))
366      (is (eql (reified-construct reifier-name) homer-name))
367      (is (eql (reifier homer-variant) reifier-variant))
368      (is (eql (reified-construct reifier-variant) homer-variant))
369      (is (eql (reifier married-assoc) reifier-married-assoc))
370      (is (eql (reified-construct reifier-married-assoc) married-assoc))
371      (is (eql (reifier husband-role) reifier-husband-role))
372      (is (eql (reified-construct reifier-husband-role) husband-role))
373      (is-true (handler-case 
374                   (progn (d::delete-construct homer-occurrence)
375                          t)
376                 (condition () nil)))
377      (is-false (occurrences homer))
378      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 13))
379      (close-tm-store))))))
380
381
382(test test-xtm1.0-reification-exporter
383  "Tests the reification in the xtm1.0-exporter."
384  (let ((dir "data_base")
385        (output-file "__out__.xtm")
386        (tm-id "http://www.isidor.us/unittests/reification-xtm1.0-tests"))
387    (with-fixture initialize-destination-db (dir)
388      (base-tools:open-tm-store "data_base")
389      (make-construct 'TopicC :start-revision 100
390                      :psis
391                      (list (make-construct 'PersistentIdC
392                                            :uri constants:*topic-name-psi*)))
393      (handler-case (delete-file output-file)
394        (error () )) ;do nothing
395      (setf *TM-REVISION* 0)
396      (xtm-importer:import-from-xtm
397       *reification_xtm1.0.xtm* dir
398       :tm-id tm-id
399       :xtm-id "reification-xtm"
400       :xtm-format :1.0)
401      (export-as-xtm output-file :xtm-format :1.0 :tm-id tm-id)
402      (let ((document
403             (dom:document-element
404              (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
405        (let ((homer-topic
406               (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
407                  when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
408                                                             (xpath-single-child-elem-by-qname
409                                                              topic *xtm1.0-ns* "subjectIdentity")
410                                                             *xtm1.0-ns* "subjectIndicatorRef")
411                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
412                                          "http://simpsons.tv/homer")
413                            return t)
414                  return topic))
415              (married-assoc (xpath-single-child-elem-by-qname document *xtm1.0-ns* "association")))
416          (is-true homer-topic)
417          (is-true married-assoc)
418          (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "occurrence")
419             do (is (string= (dom:get-attribute occurrence "id") "homer-occurrence")))
420          (loop for name across (xpath-child-elems-by-qname homer-topic *xtm1.0-ns* "baseName")
421             do (progn (is (string= (dom:get-attribute name "id") "homer-name"))
422                       (loop  for variant across (xpath-child-elems-by-qname name *xtm1.0-ns* "variant")
423                          do (is (string= (dom:get-attribute variant "id") "homer-name-variant")))))
424          (is (string= (dom:get-attribute married-assoc "id") "a-married"))
425          (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm1.0-ns* "member")
426                      when (string= (dom:get-attribute role "id")
427                                    "married-husband-role")
428                      return t)))
429        (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
430                  when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
431                                                             (xpath-single-child-elem-by-qname
432                                                              topic *xtm1.0-ns* "subjectIdentity")
433                                                             *xtm1.0-ns* "subjectIndicatorRef")
434                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
435                                          "#homer-occurrence")
436                          return t)
437                    return t))
438        (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
439                    when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
440                                                               (xpath-single-child-elem-by-qname
441                                                                topic *xtm1.0-ns* "subjectIdentity")
442                                                               *xtm1.0-ns* "subjectIndicatorRef")
443                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
444                                          "#homer-name")
445                            return t)
446                    return t))
447        (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
448                    when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
449                                                               (xpath-single-child-elem-by-qname
450                                                                topic *xtm1.0-ns* "subjectIdentity")
451                                                               *xtm1.0-ns* "subjectIndicatorRef")
452                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
453                                          "#homer-name-variant")
454                            return t)
455                    return t))
456        (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
457                    when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
458                                                               (xpath-single-child-elem-by-qname
459                                                                topic *xtm1.0-ns* "subjectIdentity")
460                                                               *xtm1.0-ns* "subjectIndicatorRef")
461                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
462                                          "#a-married")
463                            return t)
464                    return t))
465        (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic")
466                    when (loop for subjectIndicatorRef across (xpath-child-elems-by-qname
467                                                               (xpath-single-child-elem-by-qname
468                                                                topic *xtm1.0-ns* "subjectIdentity")
469                                                               *xtm1.0-ns* "subjectIndicatorRef")
470                            when (string= (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href")
471                                          "#married-husband-role")
472                            return t)
473                    return t)))
474      (handler-case (delete-file output-file)
475        (error () )) ;do nothing
476      (close-tm-store))))
477
478
479(test test-xtm2.0-reification-exporter
480  "Tests the reification in the xtm2.0-exporter."
481  (let ((dir "data_base")
482        (output-file "__out__.xtm")
483        (tm-id "http://www.isidor.us/unittests/reification-xtm2.0-tests"))
484    (with-fixture initialize-destination-db (dir)
485      (base-tools:open-tm-store "data_base")
486      (make-construct 'TopicC :start-revision 100
487                      :psis
488                      (list (make-construct 'PersistentIdC
489                                            :uri constants:*topic-name-psi*)))
490      (handler-case (delete-file output-file)
491        (error () )) ;do nothing
492      (setf *TM-REVISION* 0)
493      (xtm-importer:import-from-xtm
494       *reification_xtm2.0.xtm* dir
495       :tm-id tm-id
496       :xtm-id "reification-xtm")
497      (export-as-xtm output-file :tm-id tm-id)
498      (let ((document
499             (dom:document-element
500              (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
501        (let ((homer-topic
502               (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
503                  when (loop for psi across (xpath-child-elems-by-qname topic *xtm2.0-ns* "subjectIdentifier")
504                          when (string= (dom:get-attribute psi "href") "http://simpsons.tv/homer")
505                          return t)
506                  return topic))
507              (married-assoc (xpath-single-child-elem-by-qname document *xtm2.0-ns* "association")))
508          (is-true homer-topic)
509          (is-true married-assoc)
510          (loop for occurrence across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "occurrence")
511             do (is (string= (dom:get-attribute occurrence "reifier") "http://simpsons.tv/homer-occurrence")))
512          (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name")
513             do (is (string= (dom:get-attribute name "reifier") "http://simpsons.tv/homer-name")))
514          (loop for name across (xpath-child-elems-by-qname homer-topic *xtm2.0-ns* "name")
515             do (loop for variant across (xpath-child-elems-by-qname name *xtm2.0-ns* "variant")
516                   do (is (string= (dom:get-attribute variant "reifier") "http://simpsons.tv/homer-name-variant"))))
517          (is (string= (dom:get-attribute married-assoc "reifier") "http://simpsons.tv/married-association"))
518          (is-true (loop for role across (xpath-child-elems-by-qname married-assoc *xtm2.0-ns* "role")
519                      when (string= (dom:get-attribute role "reifier") "http://simpsons.tv/married-husband-role")
520                      return t))
521          (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
522                      when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
523                              when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-occurrence")
524                              return t)
525                      return t))
526          (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
527                      when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
528                              when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name")
529                              return t)
530                      return t))
531          (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
532                      when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
533                              when (string= (dom:get-attribute ii "href") "http://simpsons.tv/homer-name-variant")
534                              return t)
535                      return t))
536          (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
537                      when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
538                              when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-association")
539                              return t)
540                      return t))
541          (is-true (loop for topic across (xpath-child-elems-by-qname document *xtm2.0-ns* "topic")
542                      when (loop for ii across (xpath-child-elems-by-qname topic *xtm2.0-ns* "itemIdentity")
543                              when (string= (dom:get-attribute ii "href") "http://simpsons.tv/married-husband-role")
544                              return t)
545                      return t)))))
546    (handler-case (delete-file output-file)
547      (error () )) ;do nothing
548    (close-tm-store)))
549
550
551(test test-rdf-importer-reification
552  "Tests the function import-node non-recursively. Especially the reification
553   of association- and occurrence-arcs."
554  (let ((db-dir "data_base")
555        (tm-id "http://test-tm/")
556        (revision-1 100)
557        (document-id "doc-id")
558        (doc-1
559         (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" "
560                 "xmlns:arcs=\"http://test/arcs/\" "
561                 "xmlns:rdfs=\"" *rdfs-ns* "\">"
562                 "<rdf:Description rdf:about=\"first-node\">"
563                 "<arcs:arc1 rdf:ID=\"reification-1\">"
564                 "<rdf:Description rdf:about=\"second-node\" />"
565                 "</arcs:arc1>"
566                 "</rdf:Description>"
567                 "<rdf:Description rdf:ID=\"#reification-1\">"
568                 "<arcs:arc2 rdf:resource=\"third-node\"/>"
569                 "</rdf:Description>"
570                 "<rdf:Description rdf:nodeID=\"fourth-node\">"
571                 "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">"
572                 "occurrence data"
573                 "</arcs:arc3>"
574                 "</rdf:Description>"
575                 "<rdf:Description rdf:ID=\"#reification-2\">"
576                 "<arcs:arc4 rdf:resource=\"fifth-node\" />"
577                 "</rdf:Description>"
578                 "</rdf:RDF>")))
579    (setf *TM-REVISION* 0)
580    (clean-out-db db-dir)
581    (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))))
582      (is-true dom-1)
583      (is (= (length (dom:child-nodes dom-1)) 1))
584      (let ((rdf-node (elt (dom:child-nodes dom-1) 0)))
585        (is (= (length (dom:child-nodes rdf-node)) 4))
586        (rdf-init-db :db-dir db-dir :start-revision revision-1)
587        (dotimes (iter (length (dom:child-nodes rdf-node)))
588          (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
589                                     tm-id revision-1
590                                     :document-id document-id))
591        (is (= (length (dom:child-nodes rdf-node)) 4))
592        (rdf-init-db :db-dir db-dir :start-revision revision-1)
593        (dotimes (iter (length (dom:child-nodes rdf-node)))
594          (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter)
595                                     tm-id revision-1
596                                     :document-id document-id))
597        (let ((reification-1 (d:get-item-by-id "http://test-tm#reification-1"
598                                             :xtm-id document-id))
599              (reification-2 (d:get-item-by-id "http://test-tm#reification-2"
600                                               :xtm-id document-id))
601              (first-node (d:get-item-by-id "http://test-tm/first-node"
602                                          :xtm-id document-id))
603              (second-node (d:get-item-by-id "http://test-tm/second-node"
604                                           :xtm-id document-id))
605              (third-node (d:get-item-by-id "http://test-tm/third-node"
606                                          :xtm-id document-id))
607              (fourth-node (d:get-item-by-id "fourth-node"
608                                             :xtm-id document-id))
609              (fifth-node (d:get-item-by-id "http://test-tm/fifth-node"
610                                            :xtm-id document-id))
611              (arc1 (d:get-item-by-id "http://test/arcs/arc1"
612                                    :xtm-id document-id))
613              (arc2 (d:get-item-by-id "http://test/arcs/arc2"
614                                    :xtm-id document-id))
615              (arc3 (d:get-item-by-id "http://test/arcs/arc3"
616                                      :xtm-id document-id))
617              (arc4 (d:get-item-by-id "http://test/arcs/arc4"
618                                      :xtm-id document-id)))
619          (is (= (length (d:psis reification-1)) 1))
620          (is (string= (d:uri (first (d:psis reification-1)))
621                       "http://test-tm#reification-1"))
622          (is (= (length (d:psis reification-2)) 1))
623          (is (string= (d:uri (first (d:psis reification-2)))
624                       "http://test-tm#reification-2"))
625          (is (= (length (d:psis first-node)) 1))
626          (is (string= (d:uri (first (d:psis first-node)))
627                       "http://test-tm/first-node"))
628          (is (= (length (d:psis second-node)) 1))
629          (is (string= (d:uri (first (d:psis second-node)))
630                       "http://test-tm/second-node"))
631          (is (= (length (d:psis third-node)) 1))
632          (is (string= (d:uri (first (d:psis third-node)))
633                       "http://test-tm/third-node"))
634          (is (= (length (d:psis fourth-node)) 0))
635          (is (= (length (d:psis fifth-node)) 1))
636          (is (string= (d:uri (first (d:psis fifth-node)))
637                       "http://test-tm/fifth-node"))
638          (is (= (length (d:psis arc1)) 1))
639          (is (string= (d:uri (first (d:psis arc1)))
640                       "http://test/arcs/arc1"))
641          (is (= (length (d:psis arc2))))
642          (is (string= (d:uri (first (d:psis arc2)))
643                       "http://test/arcs/arc2"))
644          (is (= (length (d:psis arc3))))
645          (is (string= (d:uri (first (d:psis arc3)))
646                       "http://test/arcs/arc3"))
647          (is (= (length (d:psis arc4))))
648          (is (string= (d:uri (first (d:psis arc4)))
649                       "http://test/arcs/arc4"))
650          (is (= (length (d:used-as-type arc1)) 1))
651          (is (eql (reifier (first (d:used-as-type arc1))) reification-1))
652          (is (eql (reified-construct reification-1) (first (d:used-as-type arc1))))
653          (is (eql (reifier (first (d:used-as-type arc3))) reification-2))
654          (is (eql (reified-construct reification-2) (first (d:used-as-type arc3))))))))
655  (close-tm-store))
656
657
658(test test-rdf-importer-reification-2
659  "Tests the rdf-importer, especially some reification cases of
660   the tm2rdf mapping."
661  (let ((db-dir "data_base")
662        (tm-id "http://test-tm/")
663        (revision-1 100)
664        (document-id "doc-id"))
665    (setf *TM-REVISION* 0)
666    (clean-out-db db-dir)
667    (rdf-importer:import-from-rdf
668     *reification.rdf* db-dir :tm-id tm-id
669     :document-id document-id :start-revision revision-1)
670    (open-tm-store db-dir)
671    (let ((homer (get-item-by-id "http://simpsons.tv/homer" :xtm-id document-id))
672          (bart (get-item-by-id "http://simpsons.tv/bart" :xtm-id document-id))
673          (married (get-item-by-id "http://simpsons.tv/arcs/married" :xtm-id document-id)))
674      (is-true homer)
675      (is-true bart)
676      (is-true married)
677      (is (= (length (used-as-type married)) 1))
678      (is-true (reifier (first (used-as-type married))))
679      (is-true (reified-construct (reifier (first (used-as-type married)))))
680      (is (= (length (psis (reifier (first (used-as-type married))))) 1))
681      (is (string= (uri (first (psis (reifier (first (used-as-type married))))))
682                   "http://test-tm#married-arc"))
683      (is (= (length (occurrences bart)) 1))
684      (is-true (reifier (first (occurrences bart))))
685      (is-true (reified-construct (reifier (first (occurrences bart)))))
686      (is (string= (uri (first (psis (reifier (first (occurrences bart))))))
687                   "http://test-tm#lastName-arc"))))
688  (close-tm-store))
689
690
691(test test-rdf-importer-reification-3
692  "Tests the rdf-importer, especially some reification cases of
693   the tm2rdf mapping."
694  (let ((db-dir "data_base")
695        (tm-id "http://test-tm/")
696        (revision-1 100)
697        (document-id "doc-id"))
698    (setf *TM-REVISION* 0)
699    (clean-out-db db-dir)
700    (rdf-importer:import-from-rdf
701     *reification.rdf* db-dir :tm-id tm-id
702     :document-id document-id :start-revision revision-1)
703    (open-tm-store db-dir)
704    (let ((lisa (get-item-by-id "http://simpsons.tv/lisa" :xtm-id document-id)))
705      (is-true lisa)
706      (is (= (length (names lisa)) 1))
707      (is (= (length (occurrences lisa)) 1))
708      (let ((name (first (names lisa)))
709            (occurrence (first (occurrences lisa))))
710        (is (= (length (variants name)) 1))
711        (let ((variant (first (variants name))))
712          (is-true (reifier name))
713          (is-true (reified-construct (reifier name)))
714          (is (= (length (psis (reifier name))) 1))
715          (is (string= (uri (first (psis (reifier name))))
716                       (concat tm-id "lisa-name")))
717          (is-true (reifier variant))
718          (is-true (reified-construct (reifier variant)))
719          (is (= (length (psis (reifier variant))) 1))
720          (is (string= (uri (first (psis (reifier variant))))
721                       (concat tm-id "lisa-name-variant")))
722          (is-true (reifier occurrence))
723          (is-true (reified-construct (reifier occurrence)))
724          (is (= (length (psis (reifier occurrence))) 1))
725          (is (string= (uri (first (psis (reifier occurrence))))
726                       (concat tm-id "lisa-occurrence")))))))
727  (close-tm-store))
728
729
730(test test-rdf-importer-reification-4
731  "Tests the rdf-importer, especially some reification cases of
732   the tm2rdf mapping."
733  (let ((db-dir "data_base")
734        (tm-id "http://test-tm/")
735        (revision-1 100)
736        (document-id "doc-id"))
737    (setf *TM-REVISION* 0)
738    (clean-out-db db-dir)
739    (rdf-importer:import-from-rdf
740     *reification.rdf* db-dir :tm-id tm-id
741     :document-id document-id :start-revision revision-1)
742    (open-tm-store db-dir)
743    (let ((friendship (get-item-by-id "http://simpsons.tv/friendship" :xtm-id document-id))
744          (carl (get-item-by-id "http://simpsons.tv/carl" :xtm-id document-id)))
745      (is-true friendship)
746      (is-true carl)
747      (is (= (length (used-as-type friendship)) 1))
748      (is (typep (first (used-as-type friendship)) 'd:AssociationC))
749      (let ((friendship-association (first (used-as-type friendship))))
750        (is-true (reifier friendship-association))
751        (is-true (reified-construct (reifier friendship-association)))
752        (is (= (length (psis (reifier friendship-association))) 1))
753        (is (string= (uri (first (psis (reifier friendship-association))))
754                     (concat tm-id "friendship-association")))
755        (is (= (length (roles friendship-association)) 2))
756        (let ((carl-role
757               (find-if #'(lambda(role)
758                            (eql (player role) carl))
759                        (roles friendship-association))))
760          (is-true carl-role)
761          (is-true (reifier carl-role))
762          (is-true (reified-construct (reifier carl-role)))
763          (is (= (length (psis (reifier carl-role))) 1))
764          (is (string= (uri (first (psis (reifier carl-role))))
765                       (concat tm-id "friend-role")))))))
766  (close-tm-store))
767
768
769(test test-rdf-exporter-reification
770  "Tests the reification in the rdf-exporter."
771  (let ((dir "data_base")
772        (output-file "__out__.rdf")
773        (tm-id "http://simpsons.tv"))
774    (setf *TM-REVISION* 0)
775    (handler-case (delete-file output-file)
776      (error () )) ;do nothing
777    (clean-out-db dir)
778    (rdf-importer:import-from-rdf *reification.rdf* dir
779                                  :tm-id tm-id
780                                  :document-id "reification-xtm")
781    (open-tm-store dir)
782    (rdf-exporter:export-as-rdf output-file :tm-id tm-id)
783    (let ((document
784           (dom:document-element
785            (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
786      (let ((married-arc
787             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
788                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
789                       (and (stringp about) (string= about "#married-arc")))
790                return reifier-node))
791            (lastName-arc
792             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
793                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
794                       (and (stringp about) (string= about "#lastName-arc")))
795                return reifier-node))
796            (lisa-name
797             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
798                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
799                       (and (stringp about) (string= about "#lisa-name")))
800                return reifier-node))
801            (lisa-name-variant
802             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
803                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
804                       (and (stringp about) (string= about "#lisa-name-variant")))
805                return reifier-node))
806            (lisa-occurrence
807             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
808                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
809                       (and (stringp about) (string= about "#lisa-occurrence")))
810                return reifier-node))
811            (friendship-association
812             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
813                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
814                       (and (stringp about) (string= about "#friendship-association")))
815                return reifier-node))
816            (friend-role
817             (loop for reifier-node across (xpath-child-elems-by-qname document *rdf-ns* "Description")
818                when (let ((about (dom:get-attribute-ns reifier-node *rdf-ns* "about")))
819                       (and (stringp about) (string= about "#friend-role")))
820                return reifier-node)))
821        (is-true married-arc)
822        (is-true lastName-arc)
823        (is-true lisa-name)
824        (is-true lisa-name-variant)
825        (is-true lisa-occurrence)
826        (is-true friendship-association)
827        (is-true friend-role)
828        (dolist (reifier-node (list married-arc lastName-arc lisa-name
829                                    lisa-name-variant lisa-occurrence
830                                    friendship-association friend-role))
831          (let ((author-arc
832                 (xpath-single-child-elem-by-qname reifier-node "http://simpsons.tv/arcs/" "author")))
833            (is-true author-arc)
834            (let ((resource (dom:get-attribute-ns author-arc *rdf-ns* "resource")))
835              (is (and (stringp resource) (string= resource "http://some.where/me"))))))))
836    (handler-case (delete-file output-file)
837      (error () ))) ;do nothing
838  (close-tm-store))
839
840
841(test test-rdf-exporter-reification-2
842  "Tests the reification in the rdf-exporter."
843  (let
844      ((dir "data_base")
845       (output-file "__out__.rdf")
846       (tm-id "http://simpsons.tv"))
847    (setf *TM-REVISION* 0)
848    (handler-case (delete-file output-file)
849      (error () )) ;do nothing
850    (clean-out-db dir)
851    (rdf-importer:import-from-rdf *reification.rdf* dir
852                                  :tm-id tm-id
853                                  :document-id "reification-xtm")
854    (open-tm-store dir)
855    (rdf-exporter:export-as-rdf output-file :tm-id tm-id)
856    (let ((document
857           (dom:document-element
858            (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
859      (let ((lisa
860             (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description")
861                when (let ((about (dom:get-attribute-ns resource *rdf-ns* "about")))
862                       (and (stringp about) (string= about "http://simpsons.tv/lisa")))
863                return resource)))
864        (is-true lisa)
865        (let ((lisa-name
866               (let ((arc
867                      (xpath-single-child-elem-by-qname lisa "http://isidorus/tm2rdf_mapping/" "name")))
868                 (when arc
869                   (xpath-single-child-elem-by-qname arc *rdf-ns* "Description"))))
870              (lisa-occurrence
871               (xpath-single-child-elem-by-qname lisa "http://simpsons.tv/" "profession")))
872          (is-true lisa-name)
873          (is-true lisa-occurrence)
874          (let ((lisa-name-variant
875                 (let ((arc
876                        (xpath-single-child-elem-by-qname lisa-name "http://isidorus/tm2rdf_mapping/" "variant")))
877                   (when arc
878                     (xpath-single-child-elem-by-qname arc *rdf-ns* "Description")))))
879            (is-true lisa-name-variant)
880            (let ((name-reifier
881                   (let ((elem
882                          (xpath-single-child-elem-by-qname
883                           lisa-name "http://isidorus/tm2rdf_mapping/" "reifier")))
884                     (when elem
885                       (dom:get-attribute-ns elem *rdf-ns* "resource"))))
886                  (variant-reifier
887                   (let ((elem
888                          (xpath-single-child-elem-by-qname
889                           lisa-name-variant "http://isidorus/tm2rdf_mapping/" "reifier")))
890                     (when elem
891                       (dom:get-attribute-ns elem *rdf-ns* "resource"))))
892                  (occurrence-reifier (dom:get-attribute-ns lisa-occurrence *rdf-ns* "ID")))
893              (is (and (stringp name-reifier)
894                       (string= name-reifier "lisa-name")))
895              (is (and (stringp variant-reifier)
896                       (string= variant-reifier "lisa-name-variant")))
897              (is (and (stringp occurrence-reifier)
898                       (string= occurrence-reifier "lisa-occurrence"))))))))
899    (handler-case (delete-file output-file)
900      (error () ))) ;do nothing
901  (close-tm-store))
902
903
904(test test-rdf-exporter-reification-3
905  "Tests the reification in the rdf-exporter."
906  (let ((dir "data_base")
907        (output-file "__out__.rdf")
908        (tm-id "http://simpsons.tv"))
909    (setf *TM-REVISION* 0)
910    (handler-case (delete-file output-file)
911      (error () )) ;do nothing
912    (clean-out-db dir)
913    (rdf-importer:import-from-rdf *reification.rdf* dir
914                                  :tm-id tm-id
915                                  :document-id "reification-xtm")
916    (open-tm-store dir)
917    (rdf-exporter:export-as-rdf output-file :tm-id tm-id)
918    (let ((document
919           (dom:document-element
920            (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
921      (let ((homer
922             (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description")
923                when (let ((about (dom:get-attribute-ns resource *rdf-ns* "about")))
924                       (and (stringp about) (string= about "http://simpsons.tv/homer")))
925                return resource)))
926        (is-true homer)
927        (let ((married-arc
928               (xpath-single-child-elem-by-qname homer "http://simpsons.tv/arcs/" "married")))
929          (is-true married-arc)
930          (let ((reifier-id (dom:get-attribute-ns married-arc *rdf-ns* "ID")))
931            (is (and (stringp reifier-id)
932                     (string= reifier-id "married-arc")))))))
933    (handler-case (delete-file output-file)
934      (error () ))) ;do nothing
935  (close-tm-store))
936
937
938(test test-rdf-exporter-reification-4
939  "Tests the reification in the rdf-exporter."
940  (let ((dir "data_base")
941        (output-file "__out__.rdf")
942        (tm-id "http://simpsons.tv"))
943    (setf *TM-REVISION* 0)
944    (handler-case (delete-file output-file)
945      (error () )) ;do nothing
946    (clean-out-db dir)
947    (rdf-importer:import-from-rdf *reification.rdf* dir
948                                  :tm-id tm-id
949                                  :document-id "reification-xtm")
950    (open-tm-store dir)
951    (rdf-exporter:export-as-rdf output-file :tm-id tm-id)
952    (let ((document
953           (dom:document-element
954            (cxml:parse-file output-file (cxml-dom:make-dom-builder)))))
955      (let ((association
956             (loop for resource across (xpath-child-elems-by-qname document *rdf-ns* "Description")
957                when (let ((type (xpath-single-child-elem-by-qname resource *rdf-ns* "type")))
958                       (when type
959                         (let ((type-uri
960                                (dom:get-attribute-ns type *rdf-ns* "resource")))
961                           (and (stringp type-uri)
962                                (string= type-uri "http://isidorus/tm2rdf_mapping/types/Association")))))
963                return resource)))
964        (is-true association)
965        (let ((role
966               (loop for resource across
967                    (xpath-child-elems-by-qname association "http://isidorus/tm2rdf_mapping/" "role")
968                  when (let ((description (xpath-single-child-elem-by-qname resource *rdf-ns* "Description")))
969                         (when description
970                           (xpath-single-child-elem-by-qname
971                            description "http://isidorus/tm2rdf_mapping/" "reifier")))
972                  return (xpath-single-child-elem-by-qname resource *rdf-ns* "Description"))))
973          (is-true role)
974          (let ((association-reifier
975                 (let ((elem (xpath-single-child-elem-by-qname
976                              association "http://isidorus/tm2rdf_mapping/" "reifier")))
977                   (when elem
978                     (dom:get-attribute-ns elem *rdf-ns* "resource"))))
979                (role-reifier
980                 (let ((elem (xpath-single-child-elem-by-qname
981                              role "http://isidorus/tm2rdf_mapping/" "reifier")))
982                   (when elem
983                     (dom:get-attribute-ns elem *rdf-ns* "resource")))))
984            (is-true association-reifier)
985            (is-true role-reifier)
986            (is (and (stringp association-reifier)
987                     (string= association-reifier "friendship-association")))
988            (is (and (stringp role-reifier)
989                     (string= role-reifier "friend-role")))))))
990    (handler-case (delete-file output-file)
991      (error () ))) ;do nothing
992  (close-tm-store))
993
994
995(test test-fragment-reification
996  "Tests the reification in the rdf-exporter."
997  (let ((dir "data_base")
998        (output-file "__out__.rdf")
999        (tm-id "http://simpsons.tv"))
1000    (setf *TM-REVISION* 0)
1001    (handler-case (delete-file output-file)
1002      (error () )) ;do nothing
1003    (clean-out-db dir)
1004    (rdf-importer:import-from-rdf *reification.rdf* dir
1005       :tm-id tm-id
1006       :document-id "reification-xtm")
1007    (open-tm-store dir)
1008    (let ((fragment (d:create-latest-fragment-of-topic "http://simpsons.tv/lisa")))
1009      (is-true fragment)
1010      (is (= (length (union (referenced-topics fragment)
1011                            (list (d:get-item-by-psi "http://simpsons.tv/lastName")
1012                                  (d:get-item-by-psi "http://simpsons.tv/sortName")
1013                                  (d:get-item-by-psi "http://simpsons.tv/profession")
1014                                  (d:get-item-by-psi "http://simpsons.tv/lisa-name")
1015                                  (d:get-item-by-psi "http://simpsons.tv/lisa-name-variant")
1016                                  (d:get-item-by-psi "http://simpsons.tv/lisa-occurrence"))))
1017             6)))
1018    (let ((fragment (d:create-latest-fragment-of-topic "http://simpsons.tv/carl")))
1019      (is-true fragment)
1020      (is (= (length (union (referenced-topics fragment)
1021                            (list (d:get-item-by-psi "http://simpsons.tv/friendship")
1022                                  (d:get-item-by-psi "http://simpsons.tv/friendship-association")
1023                                  (d:get-item-by-psi "http://simpsons.tv/friend")
1024                                  (d:get-item-by-psi "http://simpsons.tv/lenny")
1025                                  (d:get-item-by-psi "http://simpsons.tv/friend-role"))))
1026             5))))
1027      (close-tm-store))
1028
1029
1030(defun run-reification-tests ()
1031  (it.bese.fiveam:run! 'reification-test))
Note: See TracBrowser for help on using the repository browser.