source: trunk/src/unit_tests/json_test.lisp

Last change on this file was 470, checked in by lgiessmann, 13 years ago

fixed ticket #111 and adapted all unit-tests
  • Property svn:eol-style set to native
File size: 116.4 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 :json-test
11  (:use
12   :common-lisp
13   :xtm-importer
14   :json-exporter
15   :json-importer
16   :json-tmcl
17   :base-tools
18   :datamodel
19   :it.bese.FiveAM
20   :unittests-constants
21   :json-delete-interface
22   :fixtures)
23  (:export :test-to-json-string-topics
24           :test-to-json-string-associations
25           :test-to-json-string-fragments
26           :test-get-fragment-values-from-json-list-general
27           :test-get-fragment-values-from-json-list-names
28           :test-get-fragment-values-from-json-list-occurrences
29           :test-get-fragment-values-from-json-list-topicStubs
30           :test-get-fragment-values-from-json-list-associations
31           :run-json-tests
32           :test-json-importer-general-1
33           :test-json-importer-general-2
34           :test-json-importer-general-3
35           :test-json-importer-topics-1
36           :test-json-importer-topics-2
37           :test-json-importer-topics-3
38           :test-json-importer-topics-4
39           :test-json-importer-associations
40           :test-json-importer-merge-1
41           :test-json-importer-merge-2
42           :test-json-importer-merge-3
43           :test-get-all-topic-psis
44           :test-delete-from-json-identifiers
45           :test-delete-from-json-topic
46           :test-delete-from-json-name
47           :test-delete-from-json-occurrence
48           :test-delete-from-json-variant
49           :test-delete-from-json-association
50           :test-delete-from-json-role
51           :test-occurrence-xml-content))
52
53
54(in-package :json-test)
55
56
57(def-suite json-tests
58     :description "tests various functions of the json module")
59
60(in-suite json-tests)
61
62
63(defun read-file (strm)
64  "Reads a file from the beginning to the end."
65  (if (= (cl-user::stream-file-position strm) (file-length strm))
66      ""
67      (format nil "~a~%~a" (read-line strm) (read-file strm))))
68
69
70(defvar *t100-1* "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
71
72(defvar *t100-2* "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
73
74(defvar *t100-3* "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
75
76(defvar *t64* "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
77
78
79(test test-to-json-string-topics
80  (let ((dir "data_base")
81        (rev-0 0))
82    (with-fixture initialize-destination-db (dir)
83      (xtm-importer:setup-repository
84       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
85       :xtm-id *TEST-TM*) 
86      (open-tm-store dir)
87      (let ((t50a (get-item-by-id "t50a" :xtm-id *TEST-TM* :revision rev-0)))
88        (let ((t50a-string (export-construct-as-isidorus-json-string t50a :revision 0))
89              (json-string 
90               (concat "{\"id\":\"" (topic-id t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" )))
91          (is (string= t50a-string json-string)))
92        (let ((t8 (get-item-by-id "t8" :revision rev-0 :xtm-id *TEST-TM*)))
93          (let ((t8-string (export-construct-as-isidorus-json-string
94                            t8 :revision rev-0 :xtm-id *TEST-TM*))
95                (json-string 
96                 (concat "{\"id\":\"" (topic-id t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}")))
97            (is (string= t8-string json-string))))
98        (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm" :revision rev-0)))
99          (let ((t-topic-string (export-construct-as-isidorus-json-string
100                                 t-topic :xtm-id "core.xtm"
101                                                :revision rev-0))
102                (json-string
103                 (concat "{\"id\":\"" (topic-id t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}")))
104            (is (string= t-topic-string json-string))))
105        (let ((t301 (get-item-by-id "t301" :xtm-id *TEST-TM* :revision rev-0)))
106          (let ((t301-string (export-construct-as-isidorus-json-string
107                              t301 :xtm-id *TEST-TM* :revision rev-0))
108                (json-string
109                 (concat "{\"id\":\"" (topic-id t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}")))
110            (is (string= t301-string json-string))))
111        (let ((t100 (get-item-by-id "t100" :revision rev-0 :xtm-id *TEST-TM*)))
112          (let ((t100-string (export-construct-as-isidorus-json-string
113                              t100 :revision rev-0 :xtm-id *TEST-TM*))
114                (json-string
115                 (concat "{\"id\":\"" (topic-id t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}")))
116            (is (string= t100-string json-string))))))))
117
118
119(test test-to-json-string-associations
120  (let ((dir "data_base")
121        (rev-0 0))
122    (with-fixture initialize-destination-db (dir)
123      (xtm-importer:setup-repository
124       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
125                                  :xtm-id *TEST-TM*)
126      (open-tm-store dir)
127      (let ((t57 (get-item-by-id "t57" :revision rev-0 :xtm-id *TEST-TM*))
128            (t59 (get-item-by-id "t59" :revision rev-0 :xtm-id *TEST-TM*))
129            (t202 (get-item-by-id "t202" :revision rev-0 :xtm-id *TEST-TM*))
130            (t58 (get-item-by-id "t58" :revision rev-0 :xtm-id *TEST-TM*))
131            (t203 (get-item-by-id "t203" :revision rev-0 :xtm-id *TEST-TM*))
132            (t64 (get-item-by-id "t64" :revision rev-0 :xtm-id *TEST-TM*))
133            (t62 (get-item-by-id "t62" :revision rev-0 :xtm-id *TEST-TM*)))
134        (let ((association-1 
135               (loop for association in
136                    (elephant:get-instances-by-class 'AssociationC)
137                  when (and (eq t57 (instance-of association :revision rev-0))
138                            (eq t59 (instance-of
139                                     (first (roles association  :revision rev-0))
140                                     :revision rev-0))
141                            (eq t202 (player
142                                      (first (roles association  :revision rev-0))
143                                      :revision rev-0))
144                            (eq t58 (instance-of
145                                     (second (roles association  :revision rev-0))
146                                     :revision rev-0))
147                            (eq t203 (player
148                                      (second (roles association :revision rev-0))
149                                      :revision rev-0)))
150                  return association))
151              (association-7
152               (identified-construct 
153                (elephant:get-instance-by-value
154                 'ItemIdentifierC 'uri
155                 "http://psi.egovpt.org/itemIdentifiers#assoc_7")
156                :revision rev-0)))
157      (let ((association-1-string
158                 (export-construct-as-isidorus-json-string
159                  association-1 :revision rev-0 :xtm-id *TEST-TM*))
160                (json-string
161                 (concat "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}")))
162            (is (string= association-1-string json-string)))
163          (let ((association-7-string
164                 (export-construct-as-isidorus-json-string
165                  association-7 :revision rev-0 :xtm-id *TEST-TM*))
166                (json-string
167                 (concat "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}")))
168            (is (string= association-7-string json-string)))
169          (let ((rev-1 (get-revision)))
170            (delete-role association-7 (first (roles association-7 :revision 0))
171                         :revision rev-1)
172            (delete-role association-7 (first (roles association-7 :revision 0))
173                         :revision rev-1)
174            (delete-type association-7 (instance-of association-7 :revision 0)
175                         :revision rev-1)
176            (add-theme association-7 t62 :revision rev-1)
177            (add-theme association-7 t64 :revision rev-1))
178          (let ((association-7-string
179                 (export-construct-as-isidorus-json-string
180                  association-7 :revision rev-0 :xtm-id *TEST-TM*))
181                (json-string
182                 (concat "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}")))
183            (is (string= association-7-string json-string))))))))
184
185
186(test test-to-json-string-fragments
187  (let ((dir "data_base")
188        (rev-0 0))
189    (with-fixture initialize-destination-db (dir)
190      (xtm-importer:setup-repository
191       *notificationbase.xtm* dir  :tm-id "http://www.isidor.us/unittests/testtm"
192                                   :xtm-id *TEST-TM*)
193      (open-tm-store dir)
194      (let ((frag-t100
195             (create-latest-fragment-of-topic
196              "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata"))
197            (frag-topic
198             (create-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic")))
199        (let ((frag-t100-string
200               (concat "{\"topic\":{\"id\":\"" (d:topic-id (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}"))
201              (frag-topic-string
202               (concat "{\"topic\":{\"id\":\"" (topic-id (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}")))
203          (is (string=
204               frag-t100-string
205               (export-construct-as-isidorus-json-string
206                frag-t100 :xtm-id *TEST-TM* :revision rev-0)))
207          (is (string=
208               frag-topic-string
209               (export-construct-as-isidorus-json-string
210                frag-topic :xtm-id *TEST-TM* :revision rev-0))))))))
211
212
213(test test-get-fragment-values-from-json-list-general
214  (let ((dir "data_base")
215        (rev-0 0))
216    (with-fixture initialize-destination-db (dir)
217      (xtm-importer:setup-repository
218       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
219       :xtm-id *TEST-TM*)
220      (open-tm-store dir)
221      (let ((json-fragment
222             (let ((fragment-obj
223                    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
224               (export-construct-as-isidorus-json-string
225                fragment-obj :revision rev-0 :xtm-id *TEST-TM*))))
226        (let ((fragment-list
227               (json-importer::get-fragment-values-from-json-list
228                (json:decode-json-from-string json-fragment))))
229          (let ((topic (getf fragment-list :topic)))
230            (is (string= (getf topic :ID)
231                         (d:topic-id
232                          (d:identified-construct
233                           (elephant:get-instance-by-value
234                            'd:PersistentIdC 'd:uri
235                            "http://psi.egovpt.org/standard/Topic+Maps+2002")
236                           :revision rev-0))))
237            (is-false (getf topic :itemIdentities))
238            (is-false (getf topic :subjectLocators))
239            (is (= (length (getf topic :subjectIdentifiers)) 1))
240            (is (string= (first (getf topic :subjectIdentifiers))
241                         "http://psi.egovpt.org/standard/Topic+Maps+2002"))
242                    (is (= (length (getf topic :instanceOfs)) 1))
243                    (is (= (length (first (getf topic :instanceOfs))) 1))
244                    (is (string= (first (first (getf topic :instanceOfs)))
245                                 "http://psi.egovpt.org/types/semanticstandard"))))))))
246
247
248(test test-get-fragment-values-from-json-list-names
249  (let ((dir "data_base")
250        (rev-0 0))
251    (with-fixture initialize-destination-db (dir)
252      (xtm-importer:setup-repository
253       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
254                                  :xtm-id *TEST-TM*)
255      (open-tm-store dir)
256      (let ((json-fragment
257             (let ((fragment-obj
258                    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
259               (export-construct-as-isidorus-json-string
260                fragment-obj :revision rev-0 :xtm-id *TEST-TM*))))
261        (let ((fragment-list
262               (json-importer::get-fragment-values-from-json-list
263                (json:decode-json-from-string json-fragment))))
264          (let ((topic (getf fragment-list :topic)))
265            (is (= (length (getf topic :names)) 2))
266            (let ((name-1 (first (getf topic :names)))
267                  (name-2 (second (getf topic :names))))
268              (is-false (getf name-1 :itemIdentities))
269              (is-false (getf name-1 :type))
270              (is-false (getf name-1 :scopes))
271              (is (string= (getf name-1 :value)
272                          "Topic Maps 2002"))
273              (is-false (getf name-1 :variants))
274              (is (= (length (getf name-2 :itemIdentities)) 1))
275              (is (string= (first (getf name-2 :itemIdentities))
276                           "http://psi.egovpt.org/itemIdentifiers#t101_n2"))
277              (is (= (length (getf name-2 :type)) 1))
278              (is (string= (first (getf name-2 :type))
279                           "http://psi.egovpt.org/types/long-name"))
280              (is (= (length (getf name-2 :scopes)) 1))
281              (is (= (length (first (getf name-2 :scopes))) 1))
282              (is (string= (first (first (getf name-2 :scopes)))
283                           "http://psi.egovpt.org/types/long-name"))
284              (is (string= (getf name-2 :value)
285                           "ISO/IEC 13250:2002: Topic Maps"))
286              (is (= (length (getf name-2 :variants)) 1))
287              (let ((variant (first (getf name-2 :variants))))
288                (is (= (length (getf variant :itemIdentities)) 2))
289                (is (or (string= (first (getf variant :itemIdentities))
290                                 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
291                        (string= (first (getf variant :itemIdentities))
292                                 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
293                (is (or (string= (second (getf variant :itemIdentities))
294                                 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
295                        (string= (second (getf variant :itemIdentities))
296                                 "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
297                (is (= (length (getf variant :scopes)) 1))
298                (is (= (length (first (getf variant :scopes))) 1))
299                (is (string= (first (first (getf variant :scopes)))
300                             "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))
301                (is-false (getf variant :resourceRef))
302                (is (string= (getf (getf variant :resourceData) :datatype)
303                             "http://www.w3.org/2001/XMLSchema#string"))
304                (is (string= (getf (getf variant :resourceData) :value)
305                             "ISO/IEC-13250:2002"))))))))))
306
307
308(test test-get-fragment-values-from-json-list-occurrences
309  (let ((dir "data_base")
310        (rev-0 0))
311    (with-fixture initialize-destination-db (dir)
312      (xtm-importer:setup-repository
313       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
314                                  :xtm-id *TEST-TM*)
315      (open-tm-store dir)
316      (let ((json-fragment
317             (let ((fragment-obj
318                    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
319               (export-construct-as-isidorus-json-string
320                fragment-obj :revision rev-0 :xtm-id *TEST-TM*))))
321        (let ((fragment-list
322               (json-importer::get-fragment-values-from-json-list
323                (json:decode-json-from-string json-fragment))))
324          (let ((topic (getf fragment-list :topic)))
325            (is (= (length (getf topic :occurrences)) 4))
326            (let ((occurrence-1 (first (getf topic :occurrences)))
327                  (occurrence-2 (second (getf topic :occurrences)))
328                  (occurrence-3 (third (getf topic :occurrences)))
329                  (occurrence-4 (fourth (getf topic :occurrences)))
330                  (ref-topic
331                   (d:identified-construct
332                    (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
333                                                    "http://psi.egovpt.org/status/InternationalStandard"))))
334              (is-false (getf occurrence-1 :itemIdentities))
335              (is (= (length (getf occurrence-1 :type)) 1))
336              (is (string= (first (getf occurrence-1 :type))
337                           "http://psi.egovpt.org/types/standardHasStatus"))
338              (is-false (getf occurrence-1 :scopes))
339              (is (string= (getf occurrence-1 :resourceRef)
340                           (concat "#" (d:topic-id ref-topic))))
341              (is-false (getf occurrence-1 :resourceData))
342              (is-false (getf occurrence-2 :itemIdentities))
343              (is (= (length (getf occurrence-2 :type)) 1))
344              (is (string= (first (getf occurrence-2 :type))
345                           "http://psi.egovpt.org/types/description"))
346              (is-false (getf occurrence-2 :scopes))
347              (is-false (getf occurrence-2 :resourceRef))
348              (is (string= (getf (getf occurrence-2 :resourceData) :datatype)
349                           "http://www.w3.org/2001/XMLSchema#string"))
350              (is-true (getf (getf occurrence-2 :resourceData) :value))
351              (is-false (getf occurrence-3 :itemIdentities))
352              (is (= (length (getf occurrence-3 :type)) 1))
353              (is (string= (first (getf occurrence-3 :type))
354                           "http://psi.egovpt.org/types/standardValidFromDate"))
355              (is-false (getf occurrence-3 :scopes))
356              (is-false (getf occurrence-3 :resourceRef))
357              (is (string= (getf (getf occurrence-3 :resourceData) :datatype)
358                           "//www.w3.org/2001/XMLSchema#date"))
359              (is (string= (getf (getf occurrence-3 :resourceData) :value)
360                           "2002-05-19"))
361              (is-false (getf occurrence-4 :itemIdentities))
362              (is (= (length (getf occurrence-4 :type)) 1))
363              (is (string= (first (getf occurrence-4 :type))
364                           "http://psi.egovpt.org/types/links"))
365              (is-false (getf occurrence-4 :scopes))
366              (is (string= (getf occurrence-4 :resourceRef)
367                           "http://www1.y12.doe.gov/capabilities/sgml/sc34/document/0322_files/iso13250-2nd-ed-v2.pdf"))
368              (is-false (getf occurrence-4 :resourceData)))))))))
369
370
371(test test-get-fragment-values-from-json-list-topicStubs
372  (let ((dir "data_base")
373        (rev-0 0))
374    (with-fixture initialize-destination-db (dir)
375      (xtm-importer:setup-repository
376       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
377                                  :xtm-id *TEST-TM*)
378      (open-tm-store dir)
379      (let ((json-fragment
380             (let ((fragment-obj
381                    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
382               (export-construct-as-isidorus-json-string
383                fragment-obj :revision rev-0 :xtm-id *TEST-TM*))))
384        (let ((fragment-list
385               (json-importer::get-fragment-values-from-json-list
386                (json:decode-json-from-string json-fragment))))
387          (let ((topicStubs (getf fragment-list :topicStubs)))         
388            (is (= (length topicStubs) 15))
389            (loop for topicStub in topicStubs
390               do (let ((id (getf topicStub :ID))
391                        (itemIdentities (getf topicStub :itemIdentities))
392                        (subjectLocators (getf topicStub :subjectLocators))
393                        (subjectIdentifiers (getf topicStub :subjectIdentifiers)))
394                    (is (= (length subjectIdentifiers) 1))
395                    (let ((subjectIdentifier
396                           (first subjectIdentifiers)))
397                      (let ((topic
398                             (d:identified-construct
399                              (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
400                                                              subjectIdentifier))))
401                        (is-true topic)
402                        (is-false subjectLocators)
403                        (is (string= (d:topic-id topic) id))
404                        (cond
405                          ((string= subjectIdentifier
406                                    "http://psi.egovpt.org/types/semanticstandard")
407                           (is (= (length itemIdentities) 1))
408                           (is (string= (first itemIdentities)
409                                        "http://psi.egovpt.org/itemIdentifiers#t3a")))
410                          ((string= subjectIdentifier
411                                    "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
412                           (is-false itemIdentities))
413                          ((string= subjectIdentifier
414                                    "http://psi.egovpt.org/types/long-name")
415                           (is (= (length itemIdentities) 1))
416                           (is (string= (first itemIdentities)
417                                        "http://psi.egovpt.org/itemIdentifiers#t50a")))
418                          ((string= subjectIdentifier
419                                    "http://psi.egovpt.org/types/standardHasStatus")
420                           (is (= (length itemIdentities) 1))
421                           (is (string= (first itemIdentities)
422                                        "http://psi.egovpt.org/itemIdentifiers#t51")))
423                          ((string= subjectIdentifier
424                                    "http://psi.egovpt.org/types/description")
425                           (is (= (length itemIdentities) 1))
426                           (is (string= (first itemIdentities)
427                                        "http://psi.egovpt.org/itemIdentifiers#t53")))
428                          ((string= subjectIdentifier
429                                    "http://psi.egovpt.org/types/standardValidFromDate")
430                           (is (= (length itemIdentities) 1))
431                           (is (string= (first itemIdentities)
432                                        "http://psi.egovpt.org/itemIdentifiers#t54")))
433                          ((string= subjectIdentifier
434                                    "http://psi.egovpt.org/types/links")
435                           (is (= (length itemIdentities) 1))
436                           (is (string= (first itemIdentities)
437                                        "http://psi.egovpt.org/itemIdentifiers#t55")))
438                          ((string= subjectIdentifier
439                                    "http://psi.egovpt.org/types/standardIsAboutSubject")
440                           (is (= (length itemIdentities) 1))
441                           (is (string= (first itemIdentities)
442                                        "http://psi.egovpt.org/itemIdentifiers#t60")))
443                          ((string= subjectIdentifier "http://psi.egovpt.org/types/SubjectRoleType")
444                           (is (= (length itemIdentities) 1))
445                           (is (string= (first itemIdentities)
446                                        "http://psi.egovpt.org/itemIdentifiers#t61")))
447                          ((string= subjectIdentifier
448                                    "http://psi.egovpt.org/subject/Semantic+Description")
449                           (is-false itemIdentities))
450                          ((string= subjectIdentifier
451                                    "http://psi.egovpt.org/types/serviceUsesStandard")
452                           (is (= (length itemIdentities) 1))
453                           (is (string= (first itemIdentities)
454                                        "http://psi.egovpt.org/itemIdentifiers#t64")))
455                          ((string= subjectIdentifier
456                                    "http://psi.egovpt.org/types/ServiceRoleType")
457                           (is (= (length itemIdentities) 1))
458                           (is (string= (first itemIdentities)
459                                        "http://psi.egovpt.org/itemIdentifiers#t63")))
460                          ((string= subjectIdentifier
461                                    "http://psi.egovpt.org/service/Norwegian+National+Curriculum")
462                           (is-false itemIdentities))
463                          ((string= subjectIdentifier
464                                    "http://psi.egovpt.org/types/StandardRoleType")
465                           (is (= (length itemIdentities) 1))
466                           (is (string= (first itemIdentities)
467                                        "http://psi.egovpt.org/itemIdentifiers#t62")))
468                          ((string= subjectIdentifier
469                                    "http://psi.egovpt.org/status/InternationalStandard")
470                           (is (= (length itemIdentities) 1))
471                           (is (string= (first itemIdentities)
472                                        "http://psi.egovpt.org/itemIdentifiers#t52")))
473                          (t
474                           (is-true (format t "bad subjectIdentifier found in topicStubs"))))))))))))))
475
476
477
478(test test-get-fragment-values-from-json-list-associations
479  (let ((dir "data_base")
480        (rev-0 0))
481    (with-fixture initialize-destination-db (dir)
482      (xtm-importer:setup-repository
483       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
484                                  :xtm-id *TEST-TM*)
485      (open-tm-store dir)
486      (let ((json-fragment
487             (let ((fragment-obj
488                    (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
489               (export-construct-as-isidorus-json-string
490                fragment-obj :revision rev-0 :xtm-id *TEST-TM*))))
491        (let ((fragment-list
492               (json-importer::get-fragment-values-from-json-list
493                (json:decode-json-from-string json-fragment))))
494          (let ((f-associations (getf fragment-list :associations)))
495            (is (= (length f-associations) 2))
496            (is (= (length (getf (first f-associations) :type)) 1))
497            (is (= (length (getf (second f-associations) :type)) 1))
498            (let ((association-1
499                   (if (string= (first (getf (first f-associations) :type))
500                                "http://psi.egovpt.org/types/standardIsAboutSubject")
501                       (first f-associations)
502                       (second f-associations)))
503                  (association-2
504                   (if (string= (first (getf (first f-associations) :type))
505                                "http://psi.egovpt.org/types/serviceUsesStandard")
506                       (first f-associations)
507                       (second f-associations))))
508              (is-true association-1)
509              (is-true association-2)
510              (is-false (getf association-1 :itemIdentities))
511              (is-false (getf association-1 :scopes))
512              (is (= (length (getf association-1 :roles)) 2))
513              (let ((role-1 (first (getf association-1 :roles)))
514                    (role-2 (second (getf association-1 :roles))))
515                (is-false (getf role-1 :itemIdentities))
516                (is (= (length (getf role-1 :type))))
517                (is (string= (first (getf role-1 :type))
518                             "http://psi.egovpt.org/types/StandardRoleType"))
519                (is (= (length (getf role-1 :topicRef)) 1))
520                (is (string= (first (getf role-1 :topicRef))
521                             "http://psi.egovpt.org/standard/Topic+Maps+2002"))
522                (is-false (getf role-2 :itemIdentities))
523                (is (= (length (getf role-2 :itemIdentities))))
524                (is (string= (first (getf role-2 :type))
525                             "http://psi.egovpt.org/types/SubjectRoleType"))
526                (is (= (length (getf role-2 :topicRef)) 1))
527                (is (string= (first (getf role-2 :topicRef))
528                             "http://psi.egovpt.org/subject/Semantic+Description")))
529              (is-false (getf association-2 :itemIdentities))
530              (is-false (getf association-2 :scopes))
531              (is (= (length (getf association-2 :roles)) 2))
532              (let ((role-1 (first (getf association-2 :roles)))
533                    (role-2 (second (getf association-2 :roles))))
534                (is-false (getf role-1 :itemIdentities))
535                (is (= (length (getf role-1 :type))))
536                (is (string= (first (getf role-1 :type))
537                             "http://psi.egovpt.org/types/ServiceRoleType"))
538                (is (= (length (getf role-1 :topicRef)) 1))
539                (is (string= (first (getf role-1 :topicRef))
540                             "http://psi.egovpt.org/service/Norwegian+National+Curriculum"))
541                (is-false (getf role-2 :itemIdentities))
542                (is (= (length (getf role-2 :itemIdentities))))
543                (is (string= (first (getf role-2 :type))
544                             "http://psi.egovpt.org/types/StandardRoleType"))
545                (is (= (length (getf role-2 :topicRef)) 1))
546                (is (string= (first (getf role-2 :topicRef))
547                             "http://psi.egovpt.org/standard/Topic+Maps+2002"))))))))))
548
549
550(test test-json-importer-general-1
551  (let ((dir "data_base"))
552    (with-fixture initialize-destination-db (dir)
553      (open-tm-store dir)
554      (xtm-importer:init-isidorus)
555      (is (= (length (elephant:get-instances-by-class 'TopicC)) 14))
556      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
557      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
558      (json-importer:import-from-isidorus-json *t64*)
559      (is (= (length (elephant:get-instances-by-class 'TopicC)) 16))
560      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
561      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
562      (let ((core-tm
563             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
564                when (string= (uri (first (item-identifiers tm)))
565                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
566                return tm))           
567            (test-tm
568             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
569                when (string= (uri (first (item-identifiers tm)))
570                              "http://www.isidor.us/unittests/testtm")
571                return tm)))
572        (is-true (and core-tm test-tm))
573        (is (= (length (topics core-tm)) 14))
574        (is (= (length (associations core-tm)) 0))
575        (is (= (length (topics test-tm)) (+ 2 3)))
576        (is (= (length (associations test-tm)) 1))))))
577
578
579(test test-json-importer-general-2
580  (let ((dir "data_base"))
581    (with-fixture initialize-destination-db (dir)
582      (open-tm-store dir)
583      (xtm-importer:init-isidorus)
584      (json-importer:import-from-isidorus-json *t64*)
585      (let ((test-tm
586               (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
587                  when (string= (uri (first (item-identifiers tm)))
588                                "http://www.isidor.us/unittests/testtm")
589                  return tm)))
590        (let ((main-topic
591               (loop for topic in (topics test-tm)
592                  when (string= (uri (first (psis topic)))
593                                "http://psi.egovpt.org/types/serviceUsesStandard")
594                  return topic))
595              (sub-topic
596               (loop for topic in (topics test-tm)
597                  when (string= (uri (first (psis topic)))
598                                "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
599                  return topic)))
600          (is-true (and main-topic sub-topic))
601          (let ((instanceOf-assoc
602                 (first (associations test-tm))))
603            (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
604                         constants::*type-instance-psi*))
605            (is-false (d:themes instanceOf-assoc))
606            (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
607                         "http://www.isidor.us/unittests/testtm"))
608            (is-false (d:item-identifiers instanceOf-assoc))
609            (let ((super-type-role
610                   (loop for role in (roles instanceOf-assoc)
611                      when (string= (uri (first (psis (instance-of role))))
612                                    constants:*type-psi*)
613                      return role))
614                  (sub-type-role
615                   (loop for role in (roles instanceOf-assoc)
616                      when (string= (uri (first (psis (instance-of role))))
617                                    constants:*instance-psi*)
618                      return role)))
619              (is-true (and super-type-role sub-type-role))
620              (is (string= (uri (first (psis (player super-type-role))))
621                           "http://www.networkedplanet.com/psi/npcl/meta-types/association-type"))
622              (is (string= (uri (first (psis (player sub-type-role))))
623                           "http://psi.egovpt.org/types/serviceUsesStandard"))))
624          (is-true (= (length (item-identifiers main-topic)) 1))
625          (is-true (= (length (item-identifiers sub-topic)) 1))
626          (is-true (string= (uri (first (item-identifiers main-topic)))
627                            "http://psi.egovpt.org/itemIdentifiers#t64"))
628          (is-true (string= (uri (first (item-identifiers sub-topic)))
629                            "http://psi.egovpt.org/itemIdentifiers#t7"))
630          (is-true (= (length (names main-topic)) 1))
631          (is-true (string= (charvalue (first (names main-topic)))
632                            "service uses standard")))))))
633
634
635(test test-json-importer-general-3
636  (let ((dir "data_base"))
637    (with-fixture initialize-destination-db (dir)
638      (open-tm-store dir)
639      (xtm-importer:init-isidorus)
640      (json-importer:import-from-isidorus-json *t64*)
641      (json-importer:import-from-isidorus-json *t100-3*)
642      (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29)) ;14 new topics
643      (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 5)) ;4 new associations
644      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
645      (let ((core-tm
646             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
647                when (string= (uri (first (item-identifiers tm)))
648                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
649                return tm))           
650            (test-tm
651             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
652                when (string= (uri (first (item-identifiers tm)))
653                              "http://www.isidor.us/unittests/testtm")
654                return tm)))
655        (is-true (and core-tm test-tm))
656        (is (= (length (topics core-tm)) 14))
657        (is (= (length (associations core-tm)) 0))
658        (is (= (length (topics test-tm)) (+ 17 3)))
659        (is (= (length (associations test-tm)) 5))))))
660
661
662(test test-json-importer-topics-1
663  (let ((dir "data_base")
664        (rev-0 0))
665    (with-fixture initialize-destination-db (dir)
666      (open-tm-store dir)
667      (xtm-importer:init-isidorus)
668      (json-importer:import-from-isidorus-json *t64*)
669      (json-importer:import-from-isidorus-json *t100-3*)
670      (let ((topics (elephant:get-instances-by-class 'TopicC)))
671        (loop for topic in topics
672           do (let ((psi (uri (first (psis topic :revision rev-0)))))
673                (cond
674                  ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a
675                   (is-false (names topic :revision rev-0))
676                   (is-false (occurrences topic :revision rev-0))
677                   (is-false (locators topic :revision rev-0))
678                   (is (= (length (psis topic :revision rev-0)) 1))
679                   (is (= (length (item-identifiers topic :revision rev-0)) 1))
680                   (is (string= (uri (first (item-identifiers topic :revision rev-0)))
681                                "http://psi.egovpt.org/itemIdentifiers#t3a")))
682                  ((string= psi 
683                            "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7
684                   (is-false (names topic :revision rev-0))
685                   (is-false (occurrences topic :revision rev-0))
686                   (is-false (locators topic :revision rev-0))
687                   (is (= (length (psis topic :revision rev-0)) 1))
688                   (is (= (length (item-identifiers topic :revision rev-0)) 1))
689                   (is (string= (uri (first (item-identifiers topic :revision rev-0)))
690                                "http://psi.egovpt.org/itemIdentifiers#t7")))
691                  ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51
692                   (is-false (names topic :revision rev-0))
693                   (is-false (occurrences topic :revision rev-0))
694                   (is-false (locators topic :revision rev-0))
695                   (is (= (length (psis topic :revision rev-0)) 1))
696                   (is (= (length (item-identifiers topic :revision rev-0)) 1))
697                   (is (string= (uri (first (item-identifiers topic :revision rev-0)))
698                                "http://psi.egovpt.org/itemIdentifiers#t51")))
699                  ((string= psi "http://psi.egovpt.org/types/description") ;t53
700                   (is-false (names topic :revision rev-0))
701                   (is-false (occurrences topic :revision rev-0))
702                   (is-false (locators topic :revision rev-0))
703                   (is (= (length (psis topic :revision rev-0)) 1))
704                   (is (= (length (item-identifiers topic :revision rev-0)) 1))
705                   (is (string= (uri (first (item-identifiers topic :revision rev-0)))
706                                "http://psi.egovpt.org/itemIdentifiers#t53")))
707                  ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54
708                       (is-false (names topic :revision rev-0))
709                       (is-false (occurrences topic :revision rev-0))
710                       (is-false (locators topic :revision rev-0))
711                       (is (= (length (psis topic :revision rev-0)) 1))
712                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
713                       (is (string= 
714                            (uri (first (item-identifiers topic :revision rev-0)))
715                            "http://psi.egovpt.org/itemIdentifiers#t54"))))))))))
716
717
718(test test-json-importer-topics-2
719  (let ((dir "data_base")
720        (rev-0 0))
721    (with-fixture initialize-destination-db (dir)
722      (open-tm-store dir)
723      (xtm-importer:init-isidorus)
724      (json-importer:import-from-isidorus-json *t64*)
725      (json-importer:import-from-isidorus-json *t100-3*)
726      (let ((topics (elephant:get-instances-by-class 'TopicC)))
727        (loop for topic in topics
728           do (let ((psi (uri (first (psis topic :revision rev-0)))))
729                (cond ((string= psi "http://psi.egovpt.org/types/links") ;t55
730                       (is-false (names topic :revision rev-0))
731                       (is-false (occurrences topic :revision rev-0))
732                       (is-false (locators topic :revision rev-0))
733                       (is (= (length (psis topic :revision rev-0)) 1))
734                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
735                       (is (string=
736                            (uri (first (item-identifiers topic :revision rev-0)))
737                            "http://psi.egovpt.org/itemIdentifiers#t55")))
738                      ((string= psi "http://psi.egovpt.org/types/standardIsAboutSubject") ;t60
739                       (is-false (names topic :revision rev-0))
740                       (is-false (occurrences topic :revision rev-0))
741                       (is-false (locators topic :revision rev-0))
742                       (is (= (length (psis topic :revision rev-0)) 1))
743                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
744                       (is (string=
745                            (uri (first (item-identifiers topic :revision rev-0)))
746                            "http://psi.egovpt.org/itemIdentifiers#t60")))
747                      ((string= psi "http://psi.egovpt.org/types/SubjectRoleType") ;t61
748                       (is-false (names topic :revision rev-0))
749                       (is-false (occurrences topic :revision rev-0))
750                       (is-false (locators topic :revision rev-0))
751                       (is (= (length (psis topic :revision rev-0)) 1))
752                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
753                       (is (string=
754                            (uri (first (item-identifiers topic :revision rev-0)))
755                            "http://psi.egovpt.org/itemIdentifiers#t61")))
756                      ((string= psi
757                                "http://psi.egovpt.org/types/StandardRoleType") ;t62
758                       (is-false (names topic :revision rev-0))
759                       (is-false (occurrences topic :revision rev-0))
760                       (is-false (locators topic :revision rev-0))
761                       (is (= (length (psis topic :revision rev-0)) 1))
762                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
763                       (is (string=
764                            (uri (first (item-identifiers topic :revision rev-0)))
765                            "http://psi.egovpt.org/itemIdentifiers#t62")))
766                      ((string= psi "http://psi.egovpt.org/types/ServiceRoleType") ;t63
767                       (is-false (names topic :revision rev-0))
768                       (is-false (occurrences topic :revision rev-0))
769                       (is-false (locators topic :revision rev-0))
770                       (is (= (length (psis topic :revision rev-0)) 1))
771                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
772                       (is (string=
773                            (uri (first (item-identifiers topic :revision rev-0)))
774                            "http://psi.egovpt.org/itemIdentifiers#t63")))
775                      ((string= psi
776                                "http://psi.egovpt.org/types/serviceUsesStandard") ;t64
777                       (is (= (length (names topic :revision rev-0)) 1))
778                       (is (string= (charvalue (first (names topic :revision rev-0)))
779                                    "service uses standard"))
780                       (is-false (occurrences topic :revision rev-0))
781                       (is-false (locators topic :revision rev-0))
782                       (is (= (length (psis topic :revision rev-0)) 1))
783                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
784                       (is (string=
785                            (uri (first (item-identifiers topic :revision rev-0)))
786                            "http://psi.egovpt.org/itemIdentifiers#t64"))))))))))
787
788
789(test test-json-importer-topics-3
790  (let ((dir "data_base")
791        (rev-0 0))
792    (with-fixture initialize-destination-db (dir)
793      (open-tm-store dir)
794      (xtm-importer:init-isidorus)
795      (json-importer:import-from-isidorus-json *t64*)
796      (json-importer:import-from-isidorus-json *t100-3*)
797      (let ((topics (elephant:get-instances-by-class 'TopicC)))
798        (loop for topic in topics
799           do (let ((psi (uri (first (psis topic :revision rev-0)))))
800                (cond ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata") ;t100
801                       (is (= (length (psis topic :revision rev-0)) 1))
802                       (is (= (length (item-identifiers topic :revision rev-0)) 1))
803                       (is (string=
804                            (uri (first (item-identifiers topic :revision rev-0)))
805                            "http://psi.egovpt.org/itemIdentifiers#t100"))
806                       (is (= (length (names topic :revision rev-0)) 1))
807                       (is (string= (charvalue (first (names topic :revision rev-0)))
808                                    "ISO 19115"))
809                       (is (= (length (item-identifiers
810                                       (first (names topic :revision rev-0))
811                                       :revision rev-0))))
812                       (is (string= (uri (first
813                                          (item-identifiers
814                                           (first (names topic :revision rev-0))
815                                           :revision rev-0)))
816                                    "http://psi.egovpt.org/itemIdentifiers#t100_n1"))
817                       (is (= (length (variants
818                                       (first (names topic :revision rev-0))
819                                       :revision rev-0)) 2))
820                       (let ((variant-1 (first
821                                         (variants
822                                          (first (names topic :revision rev-0))
823                                          :revision rev-0)))
824                             (variant-2 (second
825                                         (variants 
826                                          (first (names topic :revision rev-0))
827                                          :revision rev-0))))
828                         (is (= (length
829                                 (item-identifiers variant-1 :revision rev-0)) 1))
830                         (is (string=
831                              (uri (first (item-identifiers variant-1
832                                                            :revision rev-0)))
833                              "http://psi.egovpt.org/itemIdentifiers#t100_n1_v1"))
834                         (is (= (length
835                                 (item-identifiers variant-2 :revision rev-0)) 1))
836                         (is (string= 
837                              (uri (first (item-identifiers
838                                           variant-2 :revision rev-0)))
839                              "http://psi.egovpt.org/itemIdentifiers#t100_n1_v2"))
840                         (is (= (length (themes variant-1 :revision rev-0)) 1))
841                         (is (string=
842                              (uri (first (psis (first (themes variant-1
843                                                               :revision rev-0)))))
844                              "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
845                         (is (= (length (themes variant-2 :revision rev-0)) 1))
846                         (is (string=
847                              (uri (first
848                                    (psis (first (themes variant-2
849                                                         :revision rev-0))
850                                          :revision rev-0)))
851                              "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))
852                         (is (string= (charvalue variant-1)
853                                      "Geographic Information - Metadata"))
854                         (is (string= (datatype variant-1)
855                                      "http://www.w3.org/2001/XMLSchema#string"))
856                         (is (string= (charvalue variant-2)
857                                      "ISO-19115"))
858                         (is (string= (datatype variant-2)
859                                      "http://www.w3.org/2001/XMLSchema#string")))
860                       (is (= (length (occurrences topic :revision rev-0)) 4))
861                       (let ((occ-1 (first (occurrences topic :revision rev-0)))
862                             (occ-2 (second (occurrences topic :revision rev-0)))
863                             (occ-3 (third (occurrences topic :revision rev-0)))
864                             (occ-4 (fourth (occurrences topic :revision rev-0))))
865                         (is (= (length (item-identifiers occ-1 :revision rev-0)) 1))
866                         (is (string=
867                              (uri (first (item-identifiers occ-1 :revision rev-0)))
868                              "http://psi.egovpt.org/itemIdentifiers#t100_o1"))
869                         (is (= (length (item-identifiers occ-2 :revision rev-0)) 1))
870                         (is (string=
871                              (uri (first (item-identifiers occ-2 :revision rev-0)))
872                              "http://psi.egovpt.org/itemIdentifiers#t100_o2"))
873                         (is (= (length (item-identifiers occ-3 :revision rev-0)) 1))
874                         (is (string=
875                              (uri (first (item-identifiers occ-3 :revision rev-0)))
876                              "http://psi.egovpt.org/itemIdentifiers#t100_o3"))
877                         (is (= (length (item-identifiers occ-4 :revision rev-0)) 1))
878                         (is (string=
879                              (uri (first (item-identifiers occ-4 :revision rev-0)))
880                              "http://psi.egovpt.org/itemIdentifiers#t100_o4"))
881                         (is (string=
882                              (uri (first (psis (instance-of occ-1 :revision rev-0))))
883                              "http://psi.egovpt.org/types/standardHasStatus"))
884                         (is (string=
885                              (uri (first (psis (instance-of occ-2 :revision rev-0))))
886                              "http://psi.egovpt.org/types/description"))
887                         (is (string=
888                              (uri (first (psis (instance-of occ-3 :revision rev-0))))
889                              "http://psi.egovpt.org/types/standardValidFromDate"))
890                         (is (string=
891                              (uri (first (psis (instance-of occ-4 :revision rev-0))))
892                              "http://psi.egovpt.org/types/links"))
893                         (is (string= (datatype occ-1)
894                                      "http://www.w3.org/2001/XMLSchema#anyURI"))
895                         (is (string= (charvalue occ-1)
896                                      "http://www.budabe.de/"))
897                         (is (string= (datatype occ-2)
898                                      "http://www.w3.org/2001/XMLSchema#string"))
899                         (is (string= (charvalue occ-2)
900                                      "The ISO 19115 standard ..."))
901                         (is (string= (datatype occ-3)
902                                      "http://www.w3.org/2001/XMLSchema#date"))
903                         (is (string= (charvalue occ-3)
904                                      "2003-01-01"))
905                         (is (string= (datatype occ-4)
906                                      "http://www.w3.org/2001/XMLSchema#anyURI"))
907                         (is (string= (charvalue occ-4)
908                                      "http://www.editeur.org/standards/ISO19115.pdf")))))))))))
909
910
911(test test-json-importer-topics-4
912  (let ((dir "data_base")
913        (rev-0 0))
914    (with-fixture initialize-destination-db (dir)
915      (open-tm-store dir)
916      (xtm-importer:init-isidorus)
917      (json-importer:import-from-isidorus-json *t64*)
918      (json-importer:import-from-isidorus-json *t100-3*)
919      (let ((topics (elephant:get-instances-by-class 'TopicC)))
920        (loop for topic in topics
921           do (let ((psi (uri (first (psis topic :revision rev-0)))))
922                (cond ((string=
923                        psi
924                        "http://psi.egovpt.org/subject/Semantic+Description") ;t201
925                       (is-false (names topic :revision rev-0))
926                       (is-false (occurrences topic :revision rev-0))
927                       (is-false (locators topic :revision rev-0))
928                       (is (= (length (psis topic :revision rev-0)) 1))
929                       (is-false (item-identifiers topic :revision rev-0)))
930                      ((string= psi "http://psi.egovpt.org/subject/GeoData") ;t203
931                       (is-false (names topic :revision rev-0))
932                       (is-false (occurrences topic :revision rev-0))
933                       (is-false (locators topic :revision rev-0))
934                       (is (= (length (psis topic :revision rev-0)) 1))
935                       (is-false (item-identifiers topic :revision rev-0)))
936                      ((or (string= psi
937                                    "http://psi.egovpt.org/service/Google+Maps") ;t301a
938                           (string= psi "http://maps.google.com"))
939                       (is-false (names topic :revision rev-0))
940                       (is-false (occurrences topic :revision rev-0))
941                       (is-false (locators topic :revision rev-0))
942                       (is (= (length (psis topic :revision rev-0)) 2))
943                       (is (or (string= (uri (first (psis topic :revision rev-0)))
944                                        "http://psi.egovpt.org/service/Google+Maps")
945                               (string= (uri (first (psis topic :revision rev-0)))
946                                        "http://maps.google.com")))
947                       (is (or (string= (uri (second (psis topic :revision rev-0)))
948                                        "http://psi.egovpt.org/service/Google+Maps")
949                               (string= (uri (second (psis topic :revision rev-0)))
950                                        "http://maps.google.com")))
951                       (is-false (item-identifiers topic :revision rev-0))))))))))
952                     
953
954(test test-json-importer-associations
955  (let ((dir "data_base")
956        (rev-0 0))
957    (with-fixture initialize-destination-db (dir)
958      (open-tm-store dir)
959      (xtm-importer:init-isidorus)
960      (json-importer:import-from-isidorus-json *t64*)
961      (json-importer:import-from-isidorus-json *t100-3*)
962      (let ((assoc-7
963             (identified-construct
964              (elephant:get-instance-by-value
965               'ItemidentifierC 'uri
966               "http://psi.egovpt.org/itemIdentifiers#assoc_7")
967              :revision rev-0)))
968        (is (= (length (item-identifiers assoc-7 :revision rev-0))))
969        (is (string= (uri (first (item-identifiers assoc-7 :revision rev-0)))
970                     "http://psi.egovpt.org/itemIdentifiers#assoc_7"))
971        (is (= (length (roles assoc-7 :revision rev-0)) 2))
972        (is (string= (uri (first (psis (instance-of assoc-7 :revision rev-0)
973                                       :revision rev-0)))
974                     "http://psi.egovpt.org/types/serviceUsesStandard"))
975        (let ((role-1 (first (roles assoc-7 :revision rev-0)))
976              (role-2 (second (roles assoc-7 :revision rev-0))))
977          (is (string= (uri (first (psis (instance-of role-1 :revision rev-0)
978                                         :revision rev-0)))
979                       "http://psi.egovpt.org/types/ServiceRoleType"))
980          (is (or (string= (uri (first (psis (player role-1 :revision rev-0)
981                                             :revision rev-0)))
982                           "http://psi.egovpt.org/service/Google+Maps")
983                  (string= (uri (first (psis (player role-1 :revision rev-0)
984                                             :revision rev-0)))
985                           "http://maps.google.com")))
986          (is (string= (uri (first (psis (instance-of role-2 :revision rev-0)
987                                         :revision rev-0)))
988                       "http://psi.egovpt.org/types/StandardRoleType"))
989          (is (string= (uri (first (psis (player role-2 :revision rev-0)
990                                         :revision rev-0)))
991                       "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")))))))
992
993
994(test test-json-importer-merge-1
995  (let ((dir "data_base")
996        (rev-0 0))
997    (with-fixture initialize-destination-db (dir)
998      (open-tm-store dir)
999      (xtm-importer:init-isidorus)
1000      (is (= (length (elephant:get-instances-by-class 'TopicC)) 14))
1001      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
1002      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
1003      (json-importer:import-from-isidorus-json *t100-1*)
1004      (is (= (length (elephant:get-instances-by-class 'TopicC)) 18))
1005      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
1006      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
1007      (let ((core-tm
1008             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1009                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1010                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
1011                return tm))           
1012            (test-tm
1013             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1014                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1015                              "http://www.isidor.us/unittests/testtm")
1016                return tm)))
1017        (is-true (and core-tm test-tm)))
1018      (json-importer:import-from-isidorus-json *t100-2*)
1019      (is (= (length (elephant:get-instances-by-class 'TopicC)) 18))
1020      (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
1021      (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
1022      (let ((core-tm
1023             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1024                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1025                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
1026                return tm))           
1027            (test-tm
1028             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1029                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1030                              "http://www.isidor.us/unittests/testtm")
1031                return tm)))
1032        (is-true (and core-tm test-tm)))
1033      (let ((topics (elephant:get-instances-by-class 'TopicC)))
1034        (loop for topic in topics
1035           do (let ((psi (uri (first (psis topic :revision rev-0)))))
1036                (cond
1037                  ((string= psi "http://psi.egovpt.org/types/standard") ;t3
1038                   (is (= (length (in-topicmaps topic :revision rev-0)) 1))
1039                   (is (string=
1040                        (uri (first (item-identifiers
1041                                     (first (in-topicmaps topic :revision rev-0))
1042                                     :revision rev-0)))
1043                        "http://www.isidor.us/unittests/testtm"))
1044                   (is-false (names topic :revision rev-0))
1045                   (is-false (occurrences topic :revision rev-0))
1046                   (is-false (locators topic :revision rev-0))
1047                   (is (= (length (psis topic :revision rev-0)) 1))
1048                   (is (= (length (item-identifiers topic :revision rev-0)) 2))
1049                   (is (or (string=
1050                            (uri (first (item-identifiers topic :revision rev-0)))
1051                            "http://www.egovpt.org/itemIdentifiers#t3")
1052                           (string=
1053                            (uri (second (item-identifiers topic :revision rev-0)))
1054                            "http://www.egovpt.org/itemIdentifiers#t3")))
1055                   (is (or (string=
1056                            (uri (first (item-identifiers topic :revision rev-0)))
1057                            "http://psi.egovpt.org/itemIdentifiers#t3")
1058                           (string=
1059                            (uri (second (item-identifiers topic :revision rev-0)))
1060                            "http://psi.egovpt.org/itemIdentifiers#t3"))))
1061                  ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a
1062                   (is (= (length (in-topicmaps topic :revision rev-0)) 1))
1063                   (is (string=
1064                        (uri (first (item-identifiers
1065                                     (first (in-topicmaps topic :revision rev-0))
1066                                     :revision rev-0)))
1067                                "http://www.isidor.us/unittests/testtm"))
1068                   (is-false (names topic :revision rev-0))
1069                   (is-false (occurrences topic :revision rev-0))
1070                   (is-false (locators topic :revision rev-0))
1071                   (is (= (length (psis topic :revision rev-0)) 1))
1072                   (is (= (length (item-identifiers topic :revision rev-0)) 1))
1073                   (is (string= (uri (first (item-identifiers topic :revision rev-0)))
1074                                "http://psi.egovpt.org/itemIdentifiers#t50a")))
1075                  ((string= psi "http://psi.egovpt.org/types/links") ;t50
1076                   (is (= (length (in-topicmaps topic :revision rev-0)) 1))
1077                   (is (string=
1078                        (uri (first (item-identifiers
1079                                     (first (in-topicmaps topic :revision rev-0))
1080                                     :revision rev-0)))
1081                        "http://www.isidor.us/unittests/testtm"))
1082                   (is-false (names topic :revision rev-0))
1083                   (is-false (occurrences topic :revision rev-0))
1084                   (is-false (locators topic :revision rev-0))
1085                   (is (= (length (psis topic :revision rev-0)) 1))
1086                   (is (= (length (item-identifiers topic :revision rev-0)) 2))
1087                   (is (or (string=
1088                            (uri (first (item-identifiers topic :revision rev-0)))
1089                            "http://psi.egovpt.org/itemIdentifiers#t55")
1090                           (string=
1091                            (uri (second (item-identifiers topic :revision rev-0)))
1092                            "http://psi.egovpt.org/itemIdentifiers#t55")))
1093                   (is (or (string=
1094                            (uri (first (item-identifiers topic :revision rev-0)))
1095                            "http://psi.egovpt.org/itemIdentifiers#t55_1")
1096                           (string=
1097                            (uri (second (item-identifiers topic :revision rev-0)))
1098                            "http://psi.egovpt.org/itemIdentifiers#t55_1")))))))))))
1099
1100
1101(test test-json-importer-merge-2
1102  (let ((dir "data_base")
1103        (rev-0 0))
1104    (with-fixture initialize-destination-db (dir)
1105      (open-tm-store dir)
1106      (xtm-importer:init-isidorus)
1107      (json-importer:import-from-isidorus-json *t100-1*)
1108      (let ((core-tm
1109             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1110                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1111                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
1112                return tm))
1113            (test-tm
1114             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1115                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1116                              "http://www.isidor.us/unittests/testtm")
1117                return tm)))
1118        (is-true (and core-tm test-tm)))
1119      (json-importer:import-from-isidorus-json *t100-2*)
1120      (let ((topics (elephant:get-instances-by-class 'TopicC)))
1121        (loop for topic in topics
1122           do (let ((psi (uri (first (psis topic :revision rev-0)))))
1123                (cond
1124                  ((string= psi "http://psi.egovpt.org/types/standard")
1125                   t) ;was already checked
1126                  ((string= psi "http://psi.egovpt.org/types/long-name")
1127                   t) ;was already checked
1128                  ((string= psi "http://psi.egovpt.org/types/links")
1129                   t) ;was already checked
1130                  ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100
1131                   (is (= (length (in-topicmaps topic :revision rev-0)) 1))
1132                   (is (string=
1133                        (uri (first (item-identifiers
1134                                     (first (in-topicmaps topic :revision rev-0))
1135                                     :revision rev-0)))
1136                        "http://www.isidor.us/unittests/testtm"))
1137                   (is (= (length (psis topic :revision rev-0)) 1))
1138                   (is (= (length (item-identifiers topic :revision rev-0)) 2))
1139                   (is (or (string=
1140                            (uri (first (item-identifiers topic :revision rev-0)))
1141                            "http://www.egovpt.org/itemIdentifiers#t100")
1142                           (string=
1143                            (uri (second (item-identifiers topic :revision rev-0)))
1144                            "http://www.egovpt.org/itemIdentifiers#t100")))
1145                   (is (or (string=
1146                            (uri (first (item-identifiers topic :revision rev-0)))
1147                            "http://www.egovpt.org/itemIdentifiers#t100_new")
1148                           (string=
1149                            (uri (second (item-identifiers topic :revision rev-0)))
1150                            "http://www.egovpt.org/itemIdentifiers#t100_new")))
1151                   (is (= (length (names topic :revision rev-0))))
1152                   (let ((name (first (names topic :revision rev-0))))
1153                     (is (= (length (item-identifiers name :revision rev-0)) 2))
1154                     (is (or (string=
1155                              (uri (first (item-identifiers name :revision rev-0)))
1156                              "http://www.egovpt.org/itemIdentifiers#t100_n1")
1157                             (string=
1158                              (uri (second (item-identifiers name :revision rev-0)))
1159                              "http://www.egovpt.org/itemIdentifiers#t100_n1")))
1160                     (is (or (string=
1161                              (uri (first (item-identifiers name :revision rev-0)))
1162                              "http://www.egovpt.org/itemIdentifiers#t100_n1a")
1163                             (string=
1164                              (uri (second (item-identifiers name :revision rev-0)))
1165                              "http://www.egovpt.org/itemIdentifiers#t100_n1a")))
1166                     (is (string= (charvalue name)
1167                                  "Common Lisp"))
1168                     (is (= (length (variants name :revision rev-0)) 2))
1169                     (let ((variant-1 (first (variants name :revision rev-0)))
1170                           (variant-2 (second (variants name :revision rev-0))))
1171                       (is (= (length (item-identifiers variant-1 :revision rev-0)) 1))
1172                       (is (string=
1173                            (uri (first (item-identifiers variant-1 :revision rev-0)))
1174                            "http://www.egovpt.org/itemIdentifiers#t100_n_v1"))
1175                       (is (= (length (item-identifiers variant-2 :revision rev-0)) 1))
1176                       (is (string=
1177                            (uri (first (item-identifiers variant-2 :revision rev-0)))
1178                            "http://www.egovpt.org/itemIdentifiers#t100_n_v2"))
1179                       (is (= (length (themes variant-1 :revision rev-0)) 2))
1180                       (is (or (string=
1181                                (uri
1182                                 (first
1183                                  (psis
1184                                   (first (themes variant-1 :revision rev-0))
1185                                   :revision rev-0)))
1186                                "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
1187                               (string=
1188                                (uri
1189                                 (first
1190                                  (psis (second (themes variant-1 :revision rev-0))
1191                                        :revision rev-0)))
1192                                "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")))
1193                       (is (or (string=
1194                                (uri
1195                                 (first
1196                                  (psis (first (themes variant-1 :revision rev-0))
1197                                        :revision rev-0)))
1198                                "http://psi.egovpt.org/types/long-name")
1199                               (string=
1200                                (uri
1201                                 (first
1202                                  (psis (second (themes variant-1 :revision rev-0))
1203                                        :revision rev-0)))
1204                                "http://psi.egovpt.org/types/long-name")))
1205                       (is (= (length (themes variant-2 :revision rev-0)) 1))
1206                       (is (string=
1207                            (uri
1208                             (first
1209                              (psis (first (themes variant-2 :revision rev-0))
1210                                    :revision rev-0)))
1211                            "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
1212                       (is (string= (datatype variant-1)
1213                                    "http://www.w3.org/2001/XMLSchema#string"))
1214                       (is (string= (charvalue variant-1)
1215                                    "Common-Lisp"))
1216                       (is (string= (datatype variant-2)
1217                                    "http://www.w3.org/2001/XMLSchema#string"))
1218                       (is (string= (charvalue variant-2)
1219                                    "CL"))))
1220                   (is (= (length (occurrences topic :revision rev-0)) 2))
1221                   (let ((occ-1 (first (occurrences topic :revision rev-0)))
1222                         (occ-2 (second (occurrences topic :revision rev-0))))
1223                     (is (= (length (item-identifiers occ-1 :revision rev-0)) 1))
1224                     (is (string=
1225                          (uri (first (item-identifiers occ-1 :revision rev-0)))
1226                          "http://www.egovpt.org/itemIdentifiers#t100_o1"))
1227                     (is (= (length (item-identifiers occ-2 :revision rev-0)) 1))
1228                     (is (string=
1229                          (uri (first (item-identifiers occ-2 :revision rev-0)))
1230                          "http://www.egovpt.org/itemIdentifiers#t100_o2"))
1231                     (is (string=
1232                          (uri (first (psis (instance-of occ-1 :revision rev-0)
1233                                            :revision rev-0)))
1234                          "http://psi.egovpt.org/types/links"))
1235                     (is (string=
1236                          (uri (first (psis (instance-of occ-2 :revision rev-0)
1237                                            :revision rev-0)))
1238                          "http://psi.egovpt.org/types/links"))
1239                     (is (string= (datatype occ-1)
1240                                  "http://www.w3.org/2001/XMLSchema#anyURI"))
1241                     (is (string= (charvalue occ-1)
1242                                  "http://www.common-lisp.net/"))
1243                     (is (string= (datatype occ-2)
1244                                  "http://www.w3.org/2001/XMLSchema#anyURI"))
1245                     (is (string= (charvalue occ-2)
1246                                  "http://www.cliki.net/"))))
1247                  (t
1248                   (if (or (string=
1249                            psi
1250                            "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
1251                           (string=
1252                            psi
1253                            "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
1254                           (string= psi constants:*type-instance-psi*)
1255                           (string= psi constants:*type-psi*)
1256                           (string= psi constants:*instance-psi*))
1257                       (progn
1258                         (is (= (length (in-topicmaps topic :revision rev-0)) 2))
1259                         (is (or (string=
1260                                  (uri
1261                                   (first
1262                                    (item-identifiers
1263                                     (first (in-topicmaps topic :revision rev-0))
1264                                     :revision rev-0)))
1265                                  "http://www.topicmaps.org/xtm/1.0/core.xtm")
1266                                 (string=
1267                                  (uri
1268                                   (first
1269                                    (item-identifiers
1270                                     (second (in-topicmaps topic :revision rev-0))
1271                                     :revision rev-0)))
1272                                  "http://www.topicmaps.org/xtm/1.0/core.xtm")))
1273                         (is (or (string=
1274                                  (uri
1275                                   (first
1276                                    (item-identifiers
1277                                     (first (in-topicmaps topic :revision rev-0))
1278                                     :revision rev-0)))
1279                                  "http://www.isidor.us/unittests/testtm")
1280                                 (string=
1281                                  (uri
1282                                   (first
1283                                    (item-identifiers
1284                                     (second (in-topicmaps topic :revision rev-0))
1285                                     :revision rev-0)))
1286                                  "http://www.isidor.us/unittests/testtm"))))
1287                       (progn
1288                         (is (= (length (in-topicmaps topic :revision rev-0)) 1))
1289                         (is (string=
1290                              (uri
1291                               (first
1292                                (item-identifiers
1293                                 (first (in-topicmaps topic :revision rev-0))
1294                                 :revision rev-0)))
1295                              "http://www.topicmaps.org/xtm/1.0/core.xtm"))))))))))))
1296
1297
1298(test test-json-importer-merge-3
1299  (let ((dir "data_base")
1300        (rev-0 0))
1301    (with-fixture initialize-destination-db (dir)
1302      (open-tm-store dir)
1303      (xtm-importer:init-isidorus)
1304      (json-importer:import-from-isidorus-json *t100-1*)
1305      (let ((core-tm
1306             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1307                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1308                              "http://www.topicmaps.org/xtm/1.0/core.xtm")
1309                return tm))           
1310            (test-tm
1311             (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
1312                when (string= (uri (first (item-identifiers tm :revision rev-0)))
1313                              "http://www.isidor.us/unittests/testtm")
1314                return tm)))
1315        (is-true (and core-tm test-tm)))
1316      (json-importer:import-from-isidorus-json *t100-2*)
1317      (let ((instanceOf-assoc
1318             (first (elephant:get-instances-by-class 'AssociationC))))
1319        (is (string=
1320             (uri (first (psis (instance-of instanceOf-assoc :revision rev-0)
1321                               :revision rev-0)))
1322             constants::*type-instance-psi*))
1323        (is-false (d:themes instanceOf-assoc :revision rev-0))
1324        (is (string=
1325             (d:uri
1326              (first
1327               (d:item-identifiers
1328                (first (d:in-topicmaps instanceOf-assoc :revision rev-0))
1329                :revision rev-0)))
1330             "http://www.isidor.us/unittests/testtm"))
1331        (is-false (d:item-identifiers instanceOf-assoc :revision rev-0))
1332        (let ((super-type-role
1333               (loop for role in (roles instanceOf-assoc :revision rev-0)
1334                  when (string=
1335                        (uri (first (psis (instance-of role :revision rev-0)
1336                                          :revision rev-0)))
1337                        constants:*type-psi*)
1338                  return role))
1339              (sub-type-role
1340               (loop for role in (roles instanceOf-assoc :revision rev-0)
1341                  when (string= (uri (first (psis (instance-of role :revision rev-0)
1342                                                  :revision rev-0)))
1343                                constants:*instance-psi*)
1344                  return role)))
1345          (is-true (and super-type-role sub-type-role))
1346          (is (string= (uri (first (psis (player super-type-role :revision rev-0)
1347                                         :revision rev-0)))
1348                       "http://psi.egovpt.org/types/standard"))
1349          (is (string= (uri (first (psis (player sub-type-role :revision rev-0)
1350                                         :revision rev-0)))
1351                       "http://psi.egovpt.org/standard/Common+Lisp")))))))
1352
1353
1354(test test-get-all-topic-psis
1355  (let ((dir "data_base")
1356        (rev-0 0))
1357    (with-fixture initialize-destination-db (dir)
1358      (xtm-importer:setup-repository
1359       *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
1360       :xtm-id *TEST-TM*)
1361      (open-tm-store dir)
1362      (let ((json-psis
1363             (json:decode-json-from-string (get-all-topic-psis :revision rev-0))))
1364        (is (= (length json-psis)
1365               (length (elephant:get-instances-by-class 'd:TopicC))))
1366        (loop for topic-psis in json-psis
1367           do (cond
1368                ((string= (first topic-psis)
1369                          "http://www.topicmaps.org/xtm/1.0/core.xtm#topic")
1370                 (is (= (length topic-psis) 1)))
1371                ((string= (first topic-psis)
1372                          "http://psi.topicmaps.org/iso13250/model/topic-name")
1373                 (is (= (length topic-psis) 1)))
1374                ((string= (first topic-psis)
1375                          "http://www.topicmaps.org/xtm/1.0/core.xtm#association")
1376                 (is (= (length topic-psis) 1)))
1377                ((string= (first topic-psis)
1378                          "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence")
1379                 (is (= (length topic-psis) 1)))
1380                ((string= (first topic-psis)
1381                          "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance")
1382                 (is (= (length topic-psis) 1)))
1383                ((string= (first topic-psis)
1384                          "http://www.topicmaps.org/xtm/1.0/core.xtm#class")
1385                 (is (= (length topic-psis) 1)))
1386                ((string=
1387                  (first topic-psis)
1388                  "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype")
1389                 (is (= (length topic-psis) 1)))
1390                ((string= (first topic-psis)
1391                          "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype")
1392                 (is (= (length topic-psis) 1)))
1393                ((string= (first topic-psis)
1394                          "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype")
1395                 (is (= (length topic-psis) 1)))
1396                ((string= (first topic-psis)
1397                          "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
1398                 (is (= (length topic-psis) 1)))
1399                ((string= (first topic-psis)
1400                          "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
1401                 (is (= (length topic-psis) 1)))
1402                ((string= (first topic-psis)
1403                          "http://psi.topicmaps.org/iso13250/model/type-instance")
1404                 (is (= (length topic-psis) 1)))
1405                ((string= (first topic-psis)
1406                          "http://psi.topicmaps.org/iso13250/model/type")
1407                 (is (= (length topic-psis) 1)))
1408                ((string= (first topic-psis)
1409                          "http://psi.topicmaps.org/iso13250/model/instance")
1410                 (is (= (length topic-psis) 1)))
1411                ((string=
1412                  (first topic-psis)
1413                  "http://www.networkedplanet.com/psi/npcl/meta-types/topic-type")
1414                 (is (= (length topic-psis) 1)))
1415                ((string= (first topic-psis)
1416                          "http://psi.egovpt.org/types/service")
1417                 (is (= (length topic-psis) 1)))
1418                ((string= (first topic-psis)
1419                          "http://psi.egovpt.org/types/standard")
1420                 (is (= (length topic-psis) 1)))
1421                ((string= (first topic-psis)
1422                          "http://psi.egovpt.org/types/semanticstandard")
1423                 (is (= (length topic-psis) 1)))
1424                ((string= (first topic-psis)
1425                          "http://psi.egovpt.org/types/technicalstandard")
1426                 (is (= (length topic-psis) 1)))
1427                ((string= (first topic-psis)
1428                          "http://psi.egovpt.org/types/subject")
1429                 (is (= (length topic-psis) 1)))
1430                ((string=
1431                  (first topic-psis)
1432                  "http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type")
1433                 (is (= (length topic-psis) 1)))
1434                ((string=
1435                  (first topic-psis)
1436                  "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
1437                 (is (= (length topic-psis) 1)))
1438                ((string= 
1439                  (first topic-psis)
1440                  "http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type")
1441                 (is (= (length topic-psis) 1)))
1442                ((string= (first topic-psis)
1443                          "http://psi.egovpt.org/types/topicInTaxonomy")
1444                 (is (= (length topic-psis) 1)))
1445                ((string= (first topic-psis)
1446                          "http://psi.egovpt.org/types/long-name")
1447                 (is (= (length topic-psis) 1)))
1448                ((string= (first topic-psis)
1449                          "http://psi.egovpt.org/types/standardHasStatus")
1450                 (is (= (length topic-psis) 1)))
1451                ((string= (first topic-psis)
1452                          "http://psi.egovpt.org/status/InternationalStandard")
1453                 (is (= (length topic-psis) 1)))
1454                ((string= (first topic-psis)
1455                          "http://psi.egovpt.org/types/description")
1456                 (is (= (length topic-psis) 1)))
1457                ((string= (first topic-psis)
1458                          "http://psi.egovpt.org/types/standardValidFromDate")
1459                 (is (= (length topic-psis) 1)))
1460                ((string= (first topic-psis)
1461                          "http://psi.egovpt.org/types/links")
1462                 (is (= (length topic-psis) 1)))
1463                ((string= (first topic-psis)
1464                          "http://psi.egovpt.org/types/topicIsAboutSubject")
1465                 (is (= (length topic-psis) 1)))
1466                ((string= (first topic-psis)
1467                          "http://psi.egovpt.org/types/isNarrowerSubject")
1468                 (is (= (length topic-psis) 1)))
1469                ((string= (first topic-psis)
1470                          "http://psi.egovpt.org/types/narrowerSubject")
1471                 (is (= (length topic-psis) 1)))
1472                ((string= (first topic-psis)
1473                          "http://psi.egovpt.org/types/broaderSubject")
1474                 (is (= (length topic-psis) 1)))
1475                ((string= (first topic-psis)
1476                          "http://psi.egovpt.org/types/standardIsAboutSubject")
1477                 (is (= (length topic-psis) 1)))
1478                ((string= (first topic-psis)
1479                          "http://psi.egovpt.org/types/SubjectRoleType")
1480                 (is (= (length topic-psis) 1)))
1481                ((string= (first topic-psis)
1482                          "http://psi.egovpt.org/types/StandardRoleType")
1483                 (is (= (length topic-psis) 1)))
1484                ((string= (first topic-psis)
1485                          "http://psi.egovpt.org/types/ServiceRoleType")
1486                 (is (= (length topic-psis) 1)))
1487                ((string= (first topic-psis)
1488                          "http://psi.egovpt.org/types/serviceUsesStandard")
1489                 (is (= (length topic-psis) 1)))
1490                ((string=
1491                  (first topic-psis)
1492                  "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")
1493                 (is (= (length topic-psis) 1)))
1494                ((string= (first topic-psis)
1495                          "http://psi.egovpt.org/standard/Topic+Maps+2002")
1496                 (is (= (length topic-psis) 1)))
1497                ((string= (first topic-psis)
1498                          "http://psi.egovpt.org/subject/Web+Services")
1499                 (is (= (length topic-psis) 1)))
1500                ((string= (first topic-psis)
1501                          "http://psi.egovpt.org/subject/Semantic+Description")
1502                 (is (= (length topic-psis) 1)))
1503                ((string= (first topic-psis)
1504                          "http://psi.egovpt.org/subject/Data")
1505                 (is (= (length topic-psis) 1)))
1506                ((string= (first topic-psis)
1507                          "http://psi.egovpt.org/subject/GeoData")
1508                 (is (= (length topic-psis) 1)))
1509                ((string= (first topic-psis)
1510                          "http://psi.egovpt.org/subject/Legal+Data")
1511                 (is (= (length topic-psis) 1)))
1512                ((string=
1513                  (first topic-psis)
1514                  "http://psi.egovpt.org/service/Norwegian+National+Curriculum")
1515                 (is (= (length topic-psis) 1)))
1516                ((or (string= (first topic-psis)
1517                              "http://psi.egovpt.org/service/Google+Maps")
1518                     (string= (first topic-psis)
1519                              "http://maps.google.com"))
1520                 (is (= (length topic-psis) 2))
1521                 (is (or (string= (second topic-psis)
1522                                  "http://psi.egovpt.org/service/Google+Maps")
1523                         (string= (second topic-psis)
1524                                  "http://maps.google.com"))))
1525                (t
1526                 (is-true (format t "found bad topic-psis: ~a" topic-psis)))))))))
1527
1528
1529(test test-delete-from-json-identifiers
1530  "Tests the function delete-from-json with several identifiers."
1531  (with-fixture with-empty-db ("data_base")
1532    (let ((json-psi-1 "{\"type\":\"PSI\",\"delete\":\"psi-1-1\"}")
1533          (json-psi-3 "{\"type\":\"PSI\",\"delete\":\"psi-1-3\"}")
1534          (json-sl-1 "{\"type\":\"SubjectLocator\",\"delete\":\"sl-1-1\"}")
1535          (json-sl-3 "{\"type\":\"SubjectLocator\",\"delete\":\"sl-1-3\"}")
1536          (json-ii-1 "{\"type\":\"ItemIdentity\",\"delete\":\"ii-1-1\"}")
1537          (json-ii-3 "{\"type\":\"ItemIdentity\",\"delete\":\"ii-1-3\"}")
1538          (rev-1 100)
1539          (rev-2 200))
1540      (let ((top (make-construct
1541                  'TopicC
1542                  :start-revision rev-1
1543                  :psis (list (make-construct 'PersistentIdC
1544                                              :uri "psi-1-1")
1545                              (make-construct 'PersistentIdC
1546                                              :uri "psi-1-2"))
1547                  :locators (list (make-construct 'SubjectLocatorC
1548                                                  :uri "sl-1-1")
1549                                  (make-construct 'SubjectLocatorC
1550                                                  :uri "sl-1-2"))
1551                  :item-identifiers (list (make-construct 'ItemIdentifierC
1552                                                          :uri "ii-1-2"))
1553                  :names (list (make-construct
1554                                'NameC
1555                                :charvalue "name"
1556                                :start-revision rev-1
1557                                :item-identifiers (list (make-construct
1558                                                         'ItemIdentifierC
1559                                                         :uri "ii-1-1")))))))
1560        (with-revision rev-2
1561          (is (eql top (find-item-by-revision top rev-1)))
1562          (is-false (mark-as-deleted-from-json json-psi-3))
1563          (is-false (mark-as-deleted-from-json json-sl-3))
1564          (is-false (mark-as-deleted-from-json json-ii-3))
1565          (is (= (length (psis top)) 2))
1566          (is (= (length (locators top)) 2))
1567          (is (= (length (item-identifiers top)) 1))
1568          (is (= (length (names top)) 1))
1569          (is (= (length (item-identifiers (first (names top)))) 1))
1570          (is-true (mark-as-deleted-from-json json-psi-1))
1571          (is (= (length (psis top)) 1))
1572          (is (string= (uri (first (psis top))) "psi-1-2"))
1573          (is-true (mark-as-deleted-from-json json-sl-1))
1574          (is (= (length (locators top)) 1))
1575          (is (string= (uri (first (locators top))) "sl-1-2"))
1576          (is-true (mark-as-deleted-from-json json-ii-1))
1577          (is (= (length (item-identifiers top)) 1))
1578          (is (string= (uri (first (item-identifiers top))) "ii-1-2"))
1579          (is (= (length (item-identifiers (first (names top)))) 0)))
1580        (with-revision rev-1
1581          (is (= (length (psis top)) 2))
1582          (is (= (length (locators top)) 2))
1583          (is (= (length (item-identifiers top)) 1))
1584          (is (= (length (names top)) 1))
1585          (is (= (length (item-identifiers (first (names top)))) 1)))))))
1586
1587
1588(test test-delete-from-json-topic
1589  "Tests the function delete-from-json with several identifiers."
1590  (with-fixture with-empty-db ("data_base")
1591    (let ((j-top-1 "{\"type\":\"Topic\",\"delete\":{\"id\":\"any-id\",\"itemIdentities\":[\"ii-1-1\"],\"subjectLocators\":null,\"subjectIdentifiers\":null,\"instanceOfs\":null,\"names\":null,\"occurrence\":null}}")
1592          (j-top-2 "{\"type\":\"Topic\",\"delete\":{\"id\":\"any-id\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"psi-1-1\"],\"instanceOfs\":null,\"names\":null,\"occurrence\":null}}")
1593          (j-top-3 "{\"type\":\"Topic\",\"delete\":{\"id\":\"any-id\",\"itemIdentities\":null,\"subjectLocators\":[\"sl-1-1\"],\"subjectIdentifiers\":null,\"instanceOfs\":null,\"names\":null,\"occurrence\":null}}")
1594          (j-top-4 "{\"type\":\"Topic\",\"delete\":{\"id\":\"any-id\",\"itemIdentities\":[\"ii-1-2\"],\"subjectLocators\":[\"sl-1-2\"],\"subjectIdentifiers\":[\"psi-1-2\"],\"instanceOfs\":null,\"names\":null,\"occurrence\":null}}")
1595          (rev-1 100)
1596          (rev-2 200)
1597          (rev-3 300))
1598      (let ((top-1 (make-construct
1599                    'TopicC
1600                    :start-revision rev-1
1601                    :item-identifiers (list (make-construct 'ItemIdentifierC
1602                                                            :uri "ii-1-1"))))
1603            (top-2 (make-construct
1604                    'TopicC
1605                    :start-revision rev-2
1606                    :psis (list (make-construct 'PersistentIdC
1607                                                :uri "psi-1-1"))))
1608            (top-3 (make-construct
1609                    'TopicC
1610                    :start-revision rev-1
1611                    :locators (list (make-construct 'SubjectLocatorC
1612                                                    :uri "sl-1-1"))))
1613            (top-4 (make-construct
1614                    'TopicC
1615                    :start-revision rev-1
1616                    :item-identifiers (list (make-construct 'ItemIdentifierC
1617                                                            :uri "ii-1-3"))
1618                    :psis (list (make-construct 'PersistentIdC
1619                                                :uri "psi-1-3"))
1620                    :locators (list (make-construct 'SubjectLocatorC
1621                                                    :uri "sl-1-3")))))
1622        (is-false (set-exclusive-or (get-all-topics rev-2)
1623                                    (list top-1 top-2 top-3 top-4)))
1624        (is-false (mark-as-deleted-from-json j-top-4 :revision rev-2))
1625        (is-false (set-exclusive-or (get-all-topics rev-2)
1626                                    (list top-1 top-2 top-3 top-4)))
1627        (is-true (mark-as-deleted-from-json j-top-1 :revision rev-2))
1628        (is-false (set-exclusive-or (get-all-topics rev-2)
1629                                    (list top-2 top-3 top-4)))
1630        (is-true (mark-as-deleted-from-json j-top-2 :revision rev-3))
1631        (is-false (set-exclusive-or (get-all-topics rev-3)
1632                                    (list top-3 top-4)))
1633        (is-false (set-exclusive-or (get-all-topics rev-2)
1634                                    (list top-2 top-3 top-4)))
1635        (is-true (mark-as-deleted-from-json j-top-3 :revision rev-2))
1636        (is-false (set-exclusive-or (get-all-topics rev-3)
1637                                    (list top-4)))
1638        (is-false (set-exclusive-or (get-all-topics rev-2)
1639        (list top-2 top-4)))
1640        (is-false (set-exclusive-or (get-all-topics rev-3)
1641        (list top-4)))))))
1642
1643
1644(test test-delete-from-json-name
1645  (with-fixture with-empty-db ("data_base")
1646    (let ((j-parent-1 "{\"id\":\"any-id\",\"itemIdentities\":[\"ii-1-1\"],\"subjectLocators\":null,\"subjectIdentifiers\":null,\"instanceOfs\":null,\"names\":null,\"occurrence\":null},")
1647          (j-parent-2 "{\"id\":\"any-id\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"psi-1-1\"],\"instanceOfs\":null,\"names\":null,\"occurrence\":null},")
1648          (j-type "{\"type\":\"Name\",\"parent\":")
1649          (j-name-1 "\"delete\":{\"type\":[\"nType-1\"],\"scopes\":null,\"value\":\"name-1\"}}")
1650          (j-name-2 "\"delete\":{\"type\":null,\"scopes\":[[\"nScope-1\"],[\"nScope-2\"]],\"value\":\"name-2\"}}")
1651          (j-name-3 "\"delete\":{\"type\":null,\"scopes\":null,\"value\":\"name-3\"}}")
1652          (rev-1 100)
1653          (rev-2 200))
1654      (let ((nType-1 (make-construct 'TopicC
1655                                     :start-revision rev-1
1656                                     :psis (list (make-construct 'PersistentIdC
1657                                                                 :uri "nType-1"))))
1658            (nScope-1 (make-construct 'TopicC
1659                                      :start-revision rev-1
1660                                      :psis (list (make-construct 'PersistentIdC
1661                                                                  :uri "nScope-1"))))
1662            (nScope-2 (make-construct 'TopicC
1663                                      :start-revision rev-1
1664                                      :psis (list (make-construct 'PersistentIdC
1665                                                                  :uri "nScope-2")))))
1666        (let ((j-req-1 (concat j-type j-parent-1 j-name-1))
1667              (j-req-2 (concat j-type j-parent-1 j-name-2))
1668              (j-req-3 (concat j-type j-parent-1 j-name-3))
1669              (j-req-4 (concat j-type j-parent-2 j-name-1))
1670              (j-req-5 (concat j-type j-parent-2 j-name-2))
1671              (top-1 (make-construct
1672                      'TopicC
1673                      :start-revision rev-1
1674                      :item-identifiers (list (make-construct 'ItemIdentifierC
1675                                                              :uri "ii-1-1"))
1676                      :names (list (make-construct 'NameC
1677                                                   :start-revision rev-1
1678                                                   :instance-of nType-1
1679                                                   :charvalue "name-1")
1680                                   (make-construct 'NameC
1681                                                   :start-revision rev-1
1682                                                   :themes (list nScope-1 nScope-2)
1683                                                   :charvalue "name-2")
1684                                   (make-construct 'NameC
1685                                                   :start-revision rev-1
1686                                                   :charvalue "name-3"))))
1687              (top-2 (make-construct
1688                      'TopicC
1689                      :start-revision rev-1
1690                      :psis (list (make-construct 'PersistentIdC
1691                                                  :uri "psi-1-1"))
1692                      :names (list (make-construct 'NameC
1693                                                   :start-revision rev-1
1694                                                   :instance-of nType-1
1695                                                   :charvalue "name-1")
1696                                   (make-construct 'NameC
1697                                                   :start-revision rev-1
1698                                                   :charvalue "name-3"))))
1699              (top-3 (make-construct
1700                      'TopicC
1701                      :start-revision rev-1
1702                      :locators (list (make-construct 'SubjectLocatorC
1703                                                      :uri "sl-1-1"))
1704                      :names (list (make-construct 'NameC
1705                                                   :start-revision rev-1
1706                                                   :instance-of nType-1
1707                                                   :charvalue "name-1")
1708                                   (make-construct 'NameC
1709                                                   :start-revision rev-1
1710                                                   :themes (list nScope-1 nScope-2)
1711                                                   :charvalue "name-2")
1712                                   (make-construct 'NameC
1713                                                   :start-revision rev-1
1714                                                   :charvalue "name-3")))))
1715          (with-revision rev-2
1716            (is (= (length (get-all-topics)) 6))
1717            (is (= (length (elephant:get-instances-by-class 'NameC)) 8))
1718            (is (= (length (names top-1)) 3))
1719            (is (= (length (names top-2)) 2))
1720            (is (= (length (names top-3)) 3))
1721            (is-true (mark-as-deleted-from-json j-req-1))
1722            (is-false (set-exclusive-or (map 'list #'d:charvalue (names top-1))
1723                                       (list "name-2" "name-3") :test #'string=))
1724            (is-true (mark-as-deleted-from-json j-req-2))
1725            (is-false (set-exclusive-or (map 'list #'d:charvalue (names top-1))
1726                                       (list "name-3") :test #'string=))
1727            (is-true (mark-as-deleted-from-json j-req-3))
1728            (is-false (names top-1))
1729            (is-false (mark-as-deleted-from-json j-req-3))
1730            (is-false (names top-1))
1731            (is (= (length (names top-2)) 2))
1732            (is (= (length (names top-3)) 3))
1733            (is-true (mark-as-deleted-from-json j-req-4))
1734            (is-false (set-exclusive-or (map 'list #'d:charvalue (names top-2))
1735                                       (list "name-3") :test #'string=))
1736            (is-false (mark-as-deleted-from-json j-req-5))
1737            (is-false (set-exclusive-or (map 'list #'d:charvalue (names top-2))
1738                                       (list "name-3") :test #'string=))
1739            (is (= (length (names top-3)) 3))))))))
1740
1741
1742(test test-delete-from-json-occurrence
1743  (with-fixture with-empty-db ("data_base")
1744    (let ((j-parent-1 "{\"id\":\"any-id\",\"itemIdentities\":[\"ii-1-1\"],\"subjectLocators\":null,\"subjectIdentifiers\":null,\"instanceOfs\":null,\"names\":null,\"occurrence\":null},")
1745          (j-parent-2 "{\"id\":\"any-id\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"psi-1-1\"],\"instanceOfs\":null,\"names\":null,\"occurrence\":null},")
1746          (j-type "{\"type\":\"Occurrence\",\"parent\":")
1747          (j-occ-1 "\"delete\":{\"type\":[\"oType-1\"],\"scopes\":null,\"resourceRef\":\"value-1\"}}")
1748          (j-occ-2 "\"delete\":{\"type\":[\"oType-2\"],\"scopes\":[[\"oScope-1\"],[\"oScope-2\"]],\"resourceData\":{\"datatype\":\"datatype-1\",\"value\":\"value-2\"}}}")
1749          (j-occ-3 "\"delete\":{\"type\":[\"oType-1\"],\"scopes\":null,\"resourceData\":{\"datatype\":\"datatype-2\",\"value\":\"value-3\"}}}")
1750          (rev-1 100)
1751          (rev-2 200))
1752      (let ((oType-1 (make-construct 'TopicC
1753                                     :start-revision rev-1
1754                                     :psis (list (make-construct 'PersistentIdC
1755                                                                 :uri "oType-1"))))
1756            (oType-2 (make-construct 'TopicC
1757                                     :start-revision rev-1
1758                                     :psis (list (make-construct 'PersistentIdC
1759                                                                 :uri "oType-2"))))
1760            (oScope-1 (make-construct 'TopicC
1761                                      :start-revision rev-1
1762                                      :psis (list (make-construct 'PersistentIdC
1763                                                                  :uri "oScope-1"))))
1764            (oScope-2 (make-construct 'TopicC
1765                                      :start-revision rev-1
1766                                      :psis (list (make-construct 'PersistentIdC
1767                                                                  :uri "oScope-2")))))
1768        (let ((j-req-1 (concat j-type j-parent-1 j-occ-1))
1769              (j-req-2 (concat j-type j-parent-1 j-occ-2))
1770              (j-req-3 (concat j-type j-parent-1 j-occ-3))
1771              (j-req-4 (concat j-type j-parent-2 j-occ-1))
1772              (j-req-5 (concat j-type j-parent-2 j-occ-2))
1773              (top-1 (make-construct
1774                      'TopicC
1775                      :start-revision rev-1
1776                      :item-identifiers (list (make-construct 'ItemIdentifierC
1777                                                              :uri "ii-1-1"))
1778                      :occurrences
1779                      (list (make-construct 'OccurrenceC
1780                                            :start-revision rev-1
1781                                            :instance-of oType-1
1782                                            :charvalue "value-1"
1783                                            :datatype constants::*xml-uri*)
1784                            (make-construct 'OccurrenceC
1785                                            :start-revision rev-1
1786                                            :instance-of oType-2
1787                                            :themes (list oScope-1 oScope-2)
1788                                            :charvalue "value-2"
1789                                            :datatype "datatype-1")
1790                            (make-construct 'OccurrenceC
1791                                            :start-revision rev-1
1792                                            :instance-of oType-1
1793                                            :charvalue "value-3"
1794                                            :datatype "datatype-2"))))
1795              (top-2 (make-construct
1796                      'TopicC
1797                      :start-revision rev-1
1798                      :psis (list (make-construct 'PersistentIdC
1799                                                  :uri "psi-1-1"))
1800                      :occurrences
1801                      (list (make-construct 'OccurrenceC
1802                                            :start-revision rev-1
1803                                            :instance-of oType-1
1804                                            :charvalue "value-1"
1805                                            :datatype constants::*xml-uri*)
1806                            (make-construct 'OccurrenceC
1807                                            :start-revision rev-1
1808                                            :charvalue "value-3"
1809                                            :datatype "datatype-2"))))
1810              (top-3 (make-construct
1811                      'TopicC
1812                      :start-revision rev-1
1813                      :locators (list (make-construct 'SubjectLocatorC
1814                                                      :uri "sl-1-1"))
1815                      :occurrences
1816                      (list (make-construct 'OccurrenceC
1817                                            :start-revision rev-1
1818                                            :instance-of oType-1
1819                                            :charvalue "value-1"
1820                                            :datatype constants::*xml-uri*)
1821                            (make-construct 'OccurrenceC
1822                                            :start-revision rev-1
1823                                            :themes (list oScope-1 oScope-2)
1824                                            :charvalue "value-2"
1825                                            :datatype "datatype-1")
1826                            (make-construct 'OccurrenceC
1827                                            :start-revision rev-1
1828                                            :charvalue "value-3"
1829                                            :datatype "datatype-2")))))
1830          (with-revision rev-2
1831            (is (= (length (get-all-topics)) 7))
1832            (is (= (length (elephant:get-instances-by-class 'OccurrenceC)) 8))
1833            (is (= (length (occurrences top-1)) 3))
1834            (is (= (length (occurrences top-2)) 2))
1835            (is (= (length (occurrences top-3)) 3))
1836            (is-true (mark-as-deleted-from-json j-req-1))
1837            (is-false (set-exclusive-or (map 'list #'d:charvalue
1838                                             (occurrences top-1))
1839                                        (list "value-2" "value-3") :test #'string=))
1840            (is-true (mark-as-deleted-from-json j-req-2))
1841            (is-false (set-exclusive-or (map 'list #'d:charvalue
1842                                             (occurrences top-1))
1843                                        (list "value-3") :test #'string=))
1844            (is-true (mark-as-deleted-from-json j-req-3))
1845            (is-false (occurrences top-1))
1846            (is (= (length (occurrences top-2)) 2))
1847            (is (= (length (occurrences top-3)) 3))
1848            (is-true (mark-as-deleted-from-json j-req-4))
1849            (is-false (set-exclusive-or (map 'list #'d:charvalue
1850                                             (occurrences top-2))
1851                                        (list "value-3") :test #'string=))
1852            (is-false (mark-as-deleted-from-json j-req-5))
1853            (is-false (set-exclusive-or (map 'list #'d:charvalue
1854                                             (occurrences top-2))
1855                                        (list "value-3") :test #'string=))
1856            (is (= (length (occurrences top-3)) 3))))))))
1857
1858
1859(test test-delete-from-json-variant
1860  (with-fixture with-empty-db ("data_base")
1861    (let ((j-parent-of-parent-1 "\"parentOfParent\":{\"id\":\"any-id\",\"itemIdentities\":[\"ii-1-1\"],\"subjectLocators\":null,\"subjectIdentifiers\":null,\"instanceOfs\":null,\"names\":null,\"occurrence\":null},")
1862          (j-type "{\"type\":\"Variant\",")
1863          (j-parent-1 "\"parent\":{\"type\":[\"nType-1\"],\"scopes\":null,\"value\":\"name-1\"},")
1864          (j-parent-2 "\"parent\":{\"type\":null,\"scopes\":[[\"vScope-1\"],[\"vScope-2\"]],\"value\":\"name-2\"},")
1865          (j-var-1 "\"delete\":{\"scopes\":[[\"vScope-1\"]],\"resourceRef\":\"value-1\"}}")
1866          (j-var-2 "\"delete\":{\"scopes\":[[\"vScope-1\"],[\"vScope-2\"]],\"resourceData\":{\"datatype\":\"datatype-1\",\"value\":\"value-2\"}}}")
1867          (rev-1 100)
1868          (rev-2 200))
1869      (let ((nType-1 (make-construct 'TopicC
1870                                     :start-revision rev-1
1871                                     :psis (list (make-construct 'PersistentIdC
1872                                                                 :uri "nType-1"))))
1873            (vScope-1 (make-construct 'TopicC
1874                                      :start-revision rev-1
1875                                      :psis (list (make-construct 'PersistentIdC
1876                                                                  :uri "vScope-1"))))
1877            (vScope-2 (make-construct 'TopicC
1878                                      :start-revision rev-1
1879                                      :psis (list (make-construct 'PersistentIdC
1880                                                                  :uri "vScope-2")))))
1881        (let ((j-req-1 (concat j-type j-parent-of-parent-1 j-parent-1 j-var-1))
1882              (j-req-2 (concat j-type j-parent-of-parent-1 j-parent-1 j-var-2))
1883              (j-req-3 (concat j-type j-parent-of-parent-1 j-parent-2 j-var-1))
1884              (top-1 (make-construct
1885                      'TopicC
1886                      :start-revision rev-1
1887                      :item-identifiers (list (make-construct 'ItemIdentifierC
1888                                                              :uri "ii-1-1"))
1889                      :names (list (make-construct
1890                                    'NameC
1891                                    :start-revision rev-1
1892                                    :instance-of nType-1
1893                                    :charvalue "name-1"
1894                                    :variants (list (make-construct
1895                                                     'VariantC
1896                                                     :start-revision rev-1
1897                                                     :themes (list vScope-1)
1898                                                     :datatype constants::*xml-uri*
1899                                                     :charvalue "value-1")
1900                                                    (make-construct
1901                                                     'VariantC
1902                                                     :start-revision rev-1
1903                                                     :themes (list vScope-1 vScope-2)
1904                                                     :datatype "datatype-1"
1905                                                     :charvalue "value-2")
1906                                                    (make-construct
1907                                                     'VariantC
1908                                                     :start-revision rev-1
1909                                                     :datatype "datatpye-1"
1910                                                     :charvalue "value-2")))
1911                                   (make-construct 'NameC
1912                                                   :start-revision rev-1
1913                                                   :themes (list vScope-1 vScope-2)
1914                                                   :charvalue "name-2"
1915                                                   :variants (list (make-construct
1916                                                     'VariantC
1917                                                     :start-revision rev-1
1918                                                     :themes (list vScope-1)
1919                                                     :datatype constants::*xml-uri*
1920                                                     :charvalue "value-1")
1921                                                    (make-construct
1922                                                     'VariantC
1923                                                     :start-revision rev-1
1924                                                     :themes (list vScope-1 vScope-2)
1925                                                     :datatype "datatype-1"
1926                                                     :charvalue "value-2")
1927                                                    (make-construct
1928                                                     'VariantC
1929                                                     :start-revision rev-1
1930                                                     :datatype "datatpye-1"
1931                                                     :charvalue "value-2"))))))
1932              (top-2 (make-construct
1933                      'TopicC
1934                      :start-revision rev-1
1935                      :psis (list (make-construct 'PersistentIdC
1936                                                  :uri "psi-1-1"))
1937                      :names (list (make-construct
1938                                    'NameC
1939                                    :start-revision rev-1
1940                                    :instance-of nType-1
1941                                    :charvalue "name-1"
1942                                    :variants (list (make-construct
1943                                                     'VariantC
1944                                                     :start-revision rev-1
1945                                                     :themes (list vScope-1)
1946                                                     :datatype constants::*xml-uri*
1947                                                     :charavalue "value-1")
1948                                                    (make-construct
1949                                                     'VariantC
1950                                                     :start-revision rev-1
1951                                                     :themes (list vScope-1 vScope-2)
1952                                                     :datatype "datatype-1"
1953                                                     :charvalue "value-2")
1954                                                    (make-construct
1955                                                     'VariantC
1956                                                     :start-revision rev-1
1957                                                     :datatype "datatpye-1"
1958                                                     :charvalue "value-2")))))))
1959          (with-revision rev-2
1960            (is (= (length (get-all-topics)) 5))
1961            (is (= (length (elephant:get-instances-by-class 'VariantC)) 9))
1962            (let ((name-1 (find "name-1" (names top-1) :key #'charvalue
1963                                :test #'string=))
1964                  (name-2 (find "name-2" (names top-1) :key #'charvalue
1965                                :test #'string=))
1966                  (name-3 (first (names top-2))))
1967              (is-true name-1)
1968              (is-true name-2)
1969              (is-true name-3)
1970              (is (= (length (variants name-1)) 3))
1971              (is (= (length (variants name-2)) 3))
1972              (is (= (length (variants name-3)) 3))
1973              (is-true (mark-as-deleted-from-json j-req-1))
1974              (is-false (set-exclusive-or (map 'list #'d:charvalue (variants name-1))
1975                                          (list "value-2" "value-2") :test #'string=))
1976              (is (= (length (variants name-1)) 2))
1977              (is (= (length (variants name-2)) 3))
1978              (is (= (length (variants name-3)) 3))
1979              (is-true (mark-as-deleted-from-json j-req-2))
1980              (is-false (set-exclusive-or (map 'list #'d:charvalue (variants name-1))
1981                                          (list "value-2" ) :test #'string=))
1982              (is (= (length (variants name-1)) 1))
1983              (is (= (length (variants name-2)) 3))
1984              (is (= (length (variants name-3)) 3))
1985              (is-true (mark-as-deleted-from-json j-req-3))
1986              (is-false (set-exclusive-or (map 'list #'d:charvalue (variants name-2))
1987                                          (list "value-2" ) :test #'string=))
1988              (is (= (length (variants name-1)) 1))
1989              (is (= (length (variants name-2)) 2))
1990              (is (= (length (variants name-3)) 3)))))))))
1991
1992
1993(test test-delete-from-json-association
1994  (with-fixture with-empty-db ("data_base")
1995    (let ((j-type "{\"type\":\"Association\",")
1996          (j-role-1 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-1\"]}")
1997          (j-role-2 "{\"type\":[\"rType-2\"],\"topicRef\":[\"player-1\"]}")
1998          (j-role-3 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-2\"]}")
1999          (rev-1 100)
2000          (rev-2 200))
2001      (let ((j-req-1 (concat j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}"))
2002            (j-req-2 (concat j-type "\"delete\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}"))
2003            (j-req-3 (concat j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]}}"))
2004            (aType-1 (make-construct 'TopicC
2005                                     :start-revision rev-1
2006                                     :psis (list (make-construct 'PersistentIdC
2007                                                                 :uri "aType-1"))))
2008            (aType-2 (make-construct 'TopicC
2009                                     :start-revision rev-1
2010                                     :psis (list (make-construct 'PersistentIdC
2011                                                                 :uri "aType-2"))))
2012            (aScope-1 (make-construct 'TopicC
2013                                      :start-revision rev-1
2014                                      :psis (list (make-construct 'PersistentIdC
2015                                                                  :uri "aScope-1"))))
2016            (aScope-2 (make-construct 'TopicC
2017                                      :start-revision rev-1
2018                                      :psis (list (make-construct 'PersistentIdC
2019                                                                  :uri "aScope-2"))))
2020            (player-1 (make-construct 'TopicC
2021                                      :start-revision rev-1
2022                                      :psis (list (make-construct 'PersistentIdC
2023                                                                  :uri "player-1"))))
2024            (player-2 (make-construct 'TopicC
2025                                      :start-revision rev-1
2026                                      :psis (list (make-construct 'PersistentIdC
2027                                                                  :uri "player-2"))))
2028            (rType-1 (make-construct 'TopicC
2029                                     :start-revision rev-1
2030                                     :psis (list (make-construct 'PersistentIdC
2031                                                                 :uri "rType-1"))))
2032            (rType-2 (make-construct 'TopicC
2033                                     :start-revision rev-1
2034                                     :psis (list (make-construct 'PersistentIdC
2035                                                                 :uri "rType-2")))))
2036        (let ((role-1 (list :start-revision rev-1
2037                            :player player-1
2038                            :instance-of rType-1))
2039              (role-2 (list :start-revision rev-1
2040                            :player player-1
2041                            :instance-of rType-2))
2042              (role-3 (list :start-revision rev-1
2043                            :player player-2
2044                            :instance-of rType-1)))
2045          (let ((assoc-1 (make-construct 'AssociationC
2046                                         :start-revision rev-1
2047                                         :instance-of aType-1
2048                                         :themes (list aScope-1)
2049                                         :roles (list role-1 role-2)))
2050                (assoc-2 (make-construct 'AssociationC
2051                                         :start-revision rev-1
2052                                         :instance-of aType-2
2053                                         :themes (list aScope-1 aScope-2)
2054                                         :roles (list role-1 role-2)))
2055                (assoc-3 (make-construct 'AssociationC
2056                                         :start-revision rev-1
2057                                         :instance-of aType-1
2058                                         :roles (list role-1 role-2 role-3))))
2059            (with-revision rev-2
2060              (is (= (length (get-all-associations)) 3))
2061              (is-true (mark-as-deleted-from-json j-req-1))
2062              (is-true (marked-as-deleted-p assoc-1))
2063              (is-false (set-exclusive-or (get-all-associations)
2064                                          (list assoc-2 assoc-3)))
2065              (is-true (mark-as-deleted-from-json j-req-2))
2066              (is-false (set-exclusive-or (get-all-associations)
2067                                          (list assoc-3)))
2068              (is-true (mark-as-deleted-from-json j-req-3))
2069              (is-false (get-all-associations)))))))))
2070
2071
2072(test test-delete-from-json-role
2073  (with-fixture with-empty-db ("data_base")
2074    (let ((j-type "{\"type\":\"Role\",")
2075          (j-role-1 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-1\"]}")
2076          (j-role-2 "{\"type\":[\"rType-2\"],\"topicRef\":[\"player-1\"]}")
2077          (j-role-3 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-2\"]}")
2078          (rev-1 100)
2079          (rev-2 200))
2080      (let ((j-req-1 (concat j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3"]},\"delete\":" j-role-1 "}"))
2081            (j-req-2 (concat j-type "\"parent\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-1 "}"))
2082            (j-req-3 (concat j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-2 "}"))
2083            (aType-1 (make-construct 'TopicC
2084                                     :start-revision rev-1
2085                                     :psis (list (make-construct 'PersistentIdC
2086                                                                 :uri "aType-1"))))
2087            (aType-2 (make-construct 'TopicC
2088                                     :start-revision rev-1
2089                                     :psis (list (make-construct 'PersistentIdC
2090                                                                 :uri "aType-2"))))
2091            (aScope-1 (make-construct 'TopicC
2092                                      :start-revision rev-1
2093                                      :psis (list (make-construct 'PersistentIdC
2094                                                                  :uri "aScope-1"))))
2095            (aScope-2 (make-construct 'TopicC
2096                                      :start-revision rev-1
2097                                      :psis (list (make-construct 'PersistentIdC
2098                                                                  :uri "aScope-2"))))
2099            (player-1 (make-construct 'TopicC
2100                                      :start-revision rev-1
2101                                      :psis (list (make-construct 'PersistentIdC
2102                                                                  :uri "player-1"))))
2103            (player-2 (make-construct 'TopicC
2104                                      :start-revision rev-1
2105                                      :psis (list (make-construct 'PersistentIdC
2106                                                                  :uri "player-2"))))
2107            (rType-1 (make-construct 'TopicC
2108                                     :start-revision rev-1
2109                                     :psis (list (make-construct 'PersistentIdC
2110                                                                 :uri "rType-1"))))
2111            (rType-2 (make-construct 'TopicC
2112                                     :start-revision rev-1
2113                                     :psis (list (make-construct 'PersistentIdC
2114                                                                 :uri "rType-2")))))
2115        (let ((role-1 (list :start-revision rev-1
2116                            :player player-1
2117                            :instance-of rType-1))
2118              (role-2 (list :start-revision rev-1
2119                            :player player-1
2120                            :instance-of rType-2))
2121              (role-3 (list :start-revision rev-1
2122                            :player player-2
2123                            :instance-of rType-1)))
2124          (let ((assoc-1 (make-construct 'AssociationC
2125                                         :start-revision rev-1
2126                                         :instance-of aType-1
2127                                         :themes (list aScope-1)
2128                                         :roles (list role-1 role-2 role-3)))
2129                (assoc-2 (make-construct 'AssociationC
2130                                         :start-revision rev-1
2131                                         :instance-of aType-2
2132                                         :themes (list aScope-1 aScope-2)
2133                                         :roles (list role-1 role-2 role-3))))
2134            (with-revision rev-2
2135              (is (= (length (get-all-associations)) 2))
2136              (is (= (length (roles assoc-1)) 3))
2137              (is (= (length (roles assoc-2)) 3))
2138              (is-true (mark-as-deleted-from-json j-req-1))
2139              (is-false (set-exclusive-or
2140                         (roles assoc-1)
2141                         (list role-2 role-3)
2142                         :test #'(lambda(a-role j-role)
2143                                   (and (eql (instance-of a-role)
2144                                             (getf j-role :instance-of))
2145                                        (eql (player a-role)
2146                                             (getf j-role :player))))))
2147              (is (= (length (roles assoc-1)) 2))
2148              (is (= (length (roles assoc-2)) 3))
2149              (is-true (mark-as-deleted-from-json j-req-2))
2150              (is-false (set-exclusive-or
2151                         (roles assoc-2)
2152                         (list role-2 role-3)
2153                         :test #'(lambda(a-role j-role)
2154                                   (and (eql (instance-of a-role)
2155                                             (getf j-role :instance-of))
2156                                        (eql (player a-role)
2157                                             (getf j-role :player))))))
2158              (is (= (length (roles assoc-1)) 2))
2159              (is (= (length (roles assoc-2)) 2))
2160              (is-false (mark-as-deleted-from-json j-req-3))
2161              (is (= (length (roles assoc-1)) 2))
2162              (is (= (length (roles assoc-2)) 2)))))))))
2163
2164
2165(test test-occurrence-xml-content
2166  "Tests the handling of long xml-contents in occurrences when serialized
2167   and deserialised to and from json."
2168  (with-fixture with-empty-db ("data_base")
2169    ;(open-tm-store "data_base") ;is already opened in the fixture
2170    (let ((xml-data
2171           (with-open-file
2172               (stream unittests-constants::*poems_light.xtm.txt*
2173                       :direction :input)
2174             (read-file stream)))
2175          (rev-1 100))
2176      (let* ((occ-type (make-construct 'd:TopicC
2177                                       :start-revision rev-1
2178                                       :psis (list (make-construct 'd:PersistentIdC
2179                                                                   :start-revision rev-1
2180                                                                   :uri "occ-type"))))
2181             (top (make-construct 'd:TopicC
2182                                  :start-revision rev-1
2183                                  :psis (list (make-construct 'd:PersistentIdC
2184                                                              :uri "test-topic"
2185                                                              :start-revision rev-1))
2186                                  :occurrences
2187                                  (list (make-construct 'd:OccurrenceC
2188                                                        :start-revision rev-1
2189                                                        :instance-of occ-type
2190                                                        :charvalue xml-data)))))
2191        (is-true (occurrences top))
2192        (is (string= (d:charvalue (first (occurrences top))) xml-data))
2193        (let ((json-string
2194               (export-construct-as-isidorus-json-string
2195                (first (occurrences top)))))
2196          (is (string= (cdr (third (fifth (json:decode-json-from-string
2197                                           json-string))))
2198                       xml-data)))))))
2199   
2200
2201
2202
2203(defun run-json-tests()
2204  (tear-down-test-db)
2205  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-general)
2206  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-names)
2207  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-occurrences)
2208  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-topicStubs)
2209  (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list-associations)
2210  (it.bese.fiveam:run! 'test-json-importer-general-1)
2211  (it.bese.fiveam:run! 'test-json-importer-general-2)
2212  (it.bese.fiveam:run! 'test-json-importer-general-3)
2213  (it.bese.fiveam:run! 'test-json-importer-topics-1)
2214  (it.bese.fiveam:run! 'test-json-importer-topics-2)
2215  (it.bese.fiveam:run! 'test-json-importer-topics-3)
2216  (it.bese.fiveam:run! 'test-json-importer-topics-4)
2217  (it.bese.fiveam:run! 'test-json-importer-associations)
2218  (it.bese.fiveam:run! 'test-json-importer-merge-1)
2219  (it.bese.fiveam:run! 'test-json-importer-merge-2)
2220  (it.bese.fiveam:run! 'test-json-importer-merge-3)
2221  (it.bese.fiveam:run! 'test-to-json-string-associations)
2222  (it.bese.fiveam:run! 'test-to-json-string-fragments)
2223  (it.bese.fiveam:run! 'test-to-json-string-topics)
2224  (it.bese.fiveam:run! 'test-get-all-topic-psis)
2225  (it.bese.fiveam:run! 'test-delete-from-json-identifiers)
2226  (it.bese.fiveam:run! 'test-delete-from-json-topic)
2227  (it.bese.fiveam:run! 'test-delete-from-json-name)
2228  (it.bese.fiveam:run! 'test-delete-from-json-occurrence)
2229  (it.bese.fiveam:run! 'test-delete-from-json-variant)
2230  (it.bese.fiveam:run! 'test-delete-from-json-association)
2231  (it.bese.fiveam:run! 'test-delete-from-json-role)
2232  (it.bese.fiveam:run! 'test-occurrence-xml-content))
Note: See TracBrowser for help on using the repository browser.