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

Last change on this file was 450, checked in by lgiessmann, 14 years ago

fixed ticket #108 and #109 => all exporters and importers have the same name-conventions
  • Property svn:eol-style set to native
File size: 16.5 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 :versions-test
11  (:use 
12   :common-lisp
13   :xtm-importer
14   :datamodel
15   :it.bese.FiveAM
16   :fixtures
17   :unittests-constants)
18  (:import-from :constants
19                *xtm2.0-ns*)
20  (:import-from :xml-tools
21                xpath-child-elems-by-qname
22                xpath-select-location-path)
23  (:import-from :exceptions
24                missing-reference-error
25                duplicate-identifier-error)
26  (:export :test-get-item-by-id-t100
27           :test-get-item-by-id-t301
28           :test-get-item-by-id-common-lisp
29           :test-mark-as-deleted
30           :test-instance-of-t64
31           :test-norwegian-curriculum-association
32           :test-change-lists
33           :test-changed-p
34           :versions-test
35           :run-versions-tests))
36(declaim (optimize (debug 3)))
37
38(in-package :versions-test)
39
40(def-suite versions-test
41    :description "tests  various key functions of the importer")
42
43(in-suite versions-test)
44
45(test test-get-item-by-id-t100 ()
46  "test certain characteristics of
47   http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata
48   of which two revisions are created, the original one and then one during the
49   merge with *XTM-MERGE1*"
50  (with-fixture merge-test-db ()
51    (let
52        ((top-t100-current (get-item-by-id "t100" :xtm-id *TEST-TM*))
53         (top-t100-first (get-item-by-id "t100" :xtm-id *TEST-TM*
54                                         :revision fixtures::revision1))
55         (top-t100-second (get-item-by-id "t100" :xtm-id *TEST-TM*
56                                          :revision fixtures::revision2))
57         (link-topic (get-item-by-id "t55" :xtm-id *TEST-TM*
58                                     :revision fixtures::revision2)))
59      (is (eq top-t100-current top-t100-second))
60      (is (eq top-t100-current top-t100-first))
61      (is (= 2 (length (names top-t100-current))))
62      (with-revision fixtures::revision1
63        (is (= 1 (length (names top-t100-first)))))
64      (is (string= (charvalue (first (names top-t100-first)))
65                   "ISO 19115"))
66      (with-revision fixtures::revision2 
67        (is (= 2 (length (names top-t100-second))))
68        (is (= 5 (length (occurrences top-t100-second))))
69        (is (eq link-topic (get-item-by-id "t50" :xtm-id "merge1"))) ;the topic with t55 in notificationbase has the id t50 in merge1
70        (is (eq link-topic (instance-of (fifth (occurrences top-t100-second))))))
71      (is (string= (charvalue (first (names top-t100-second)))
72                   "ISO 19115"))
73      (is (string= (charvalue (second (names top-t100-second)))
74                   "Geo Data"))
75      (is (= 5 (length (occurrences top-t100-current))))
76      (is (= 2 (length (item-identifiers top-t100-current))))
77      (with-revision fixtures::revision1
78        (is (= 4 (length (occurrences top-t100-first))))
79        (is (= 1 (length (item-identifiers top-t100-first)))))
80      (is (= 2 (length (elephant:get-instances-by-class 'd:TopicMapC)))))))
81
82
83(test test-get-item-by-id-t301 ()
84  "test characteristics of http://psi.egovpt.org/service/Google+Maps which
85   occurs twice in notificationbase.xtm but is not subsequently revised"
86  (with-fixture merge-test-db ()
87    (let 
88        ((top-t301-current (get-item-by-id "t301" :xtm-id *TEST-TM*)) 
89         (top-t301-first (get-item-by-id "t301a" :xtm-id *TEST-TM*
90                                         :revision fixtures::revision1))
91         (top-t301-second (get-item-by-id "t301a" :xtm-id *TEST-TM*
92                                          :revision fixtures::revision2)))
93      (is (eq top-t301-current top-t301-first))
94      (is (eq top-t301-current top-t301-second)))))
95
96
97(test test-get-item-by-id-common-lisp ()
98  "Get the http://psi.egovpt.org/standard/Common+Lisp topic that was first
99   introduced in merge1 and then modified in merge2"
100  (with-fixture merge-test-db ()
101    (let
102        ((top-cl-current (get-item-by-id "t100" :xtm-id "merge2"
103                                         :revision fixtures::revision3))
104         (top-cl-first (get-item-by-id "t100" :xtm-id  "merge2"
105                                       :revision fixtures::revision1))
106         (top-cl-second (get-item-by-id "t100" :xtm-id "merge1"
107                                        :revision fixtures::revision2)))
108      (is-false top-cl-first)
109      (is (eq top-cl-second top-cl-current))
110      (is (= 1 (length (names top-cl-current))))
111      (with-revision fixtures::revision2
112        (is (= 1 (length (item-identifiers top-cl-second)))))
113      (is (= 2 (length (item-identifiers top-cl-current))))
114      (with-revision fixtures::revision2
115        (is (= 1 (length (occurrences top-cl-second)))))
116      (is (= 2 (length (occurrences top-cl-current)))))))
117 
118
119(test test-norwegian-curriculum-association ()
120  "Check the various incarnations of the norwegian curriculum
121   associations across its revisions"
122  (with-fixture merge-test-db ()
123    (let*
124        ((norwegian-curr-topic
125          (get-item-by-id "t300" :xtm-id *TEST-TM* :revision fixtures::revision3))
126         
127         (curriculum-assoc ;this is the only "true" association in which the
128                           ;Norwegian Curriculum is a player in revision1
129          (parent 
130           (second    ;the first one is the instanceOf association
131            (player-in-roles 
132             norwegian-curr-topic :revision fixtures::revision3))
133           :revision fixtures::revision3))
134         (scoped-curriculum-assoc  ;this one is added in revision3
135          (parent 
136           (third 
137            (player-in-roles 
138             norwegian-curr-topic :revision fixtures::revision3))
139           :revision fixtures::revision3))
140         (semantic-standard-topic
141          (get-item-by-id "t3a" :xtm-id *TEST-TM* :revision fixtures::revision3)))
142      (is (string= "http://psi.egovpt.org/service/Norwegian+National+Curriculum"
143                   (uri (first (psis norwegian-curr-topic
144                                     :revision fixtures::revision3)))))
145      (is (= 1 (length (item-identifiers curriculum-assoc
146                                         :revision fixtures::revision3))))
147      (is (= 3 (length (psis semantic-standard-topic
148                             :revision fixtures::revision3))))
149      (with-revision fixtures::revision1
150         ;one explicit association and the association resulting
151         ;from instanceOf
152        (is (= 2 (length (player-in-roles norwegian-curr-topic))))
153        (is-false (item-identifiers curriculum-assoc))
154        (is-false (used-as-theme semantic-standard-topic)))
155      (with-revision fixtures::revision2
156        ;one explicit association and the association resulting
157        ;from instanceOf
158        (is (= 2 (length (player-in-roles norwegian-curr-topic))))
159        (is (= 1 (length (item-identifiers curriculum-assoc))))
160        (is (= 1 (length (item-identifiers (first  (roles curriculum-assoc))))))
161        (is (= 2 (length (item-identifiers (second (roles curriculum-assoc))))))
162        (is-false (used-as-theme semantic-standard-topic)))
163      (with-revision fixtures::revision3
164        ;two explicit associations and the association resulting
165        ;from instanceOf
166        (is (= 3 (length (player-in-roles norwegian-curr-topic))))
167        (is (= 1 (length (item-identifiers curriculum-assoc))))
168        (is (eq semantic-standard-topic (first (themes scoped-curriculum-assoc))))
169        (is (= 1 (length (used-as-theme semantic-standard-topic))))
170        (is (= 1 (length (item-identifiers (first  (roles curriculum-assoc))))))
171        (is (= 3 (length (item-identifiers (second (roles curriculum-assoc))))))))))
172
173
174(test test-instance-of-t64 ()
175  "Check if all instances of t64 are properly registered."
176  (with-fixture merge-test-db ()
177    (let ((t63  (get-item-by-id "t63" :xtm-id *TEST-TM*
178                                :revision fixtures::revision3))
179          (t64  (get-item-by-id "t64" :xtm-id *TEST-TM*
180                                :revision fixtures::revision3))
181          (t300 (get-item-by-id "t300" :xtm-id *TEST-TM*
182                                :revision fixtures::revision3)))
183      (with-revision fixtures::revision1
184        (let ((assocs (used-as-type t64)))
185          (is (= 2 (length assocs)))
186          (is (= (d::internal-id t63)
187                 (d::internal-id (instance-of (first (roles (first assocs)))))))
188          (is (= (d::internal-id t300)
189                 (d::internal-id (player (first (roles (first assocs)))))))))
190      (with-revision fixtures::revision2
191        (let ((assocs (used-as-type t64)))
192          (is (= 2 (length assocs)))))
193      (with-revision fixtures::revision3
194        (let ((assocs (used-as-type t64)))
195          (is (= 3 (length assocs))))))))
196
197
198(test test-change-lists ()
199  "Check various properties of changes applied to Isidor in this
200   test suite"
201  (with-fixture merge-test-db ()
202    (let ((all-revision-set (get-all-revisions))
203          (fragments-revision2
204           (get-fragments fixtures::revision2))
205          (fragments-revision3
206           (get-fragments fixtures::revision3)))
207      (is (= 3 (length all-revision-set)))
208      (is (= fixtures::revision1 (first all-revision-set)))
209      (is (= fixtures::revision2 (second all-revision-set)))
210      (is (= fixtures::revision3 (third all-revision-set)))
211      ;topics changed in revision2 / merge1: topic type, service,
212      ;standard, semantic standard, standardHasStatus, geo data
213      ;standard, common lisp, norwegian curriculum
214      (is (= 8 (length fragments-revision2)))
215      ;topics changed in revision3 / merge2: semantic standard,
216      ;norwegian curriculum, common lisp
217      (is (= 3 (length fragments-revision3)))
218      (is (= fixtures::revision3 
219             (revision (first fragments-revision3))))
220      (is (string= 
221           "http://psi.egovpt.org/types/semanticstandard"
222           (uri (first (psis (topic (first fragments-revision3)))))))
223      (format t "semantic-standard: ~a~&"
224              (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
225                                 :test #'string=))
226      (is-false
227       (set-exclusive-or 
228        '("http://psi.egovpt.org/types/standard")
229        (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
230                           :test #'string=)
231        :test #'string=))
232      ;0 if we ignore instanceOf associations
233      (is (= 0 (length (associations (first fragments-revision3)))))
234      (is (string=  "http://psi.egovpt.org/standard/Common+Lisp"
235                    (uri (first (psis (topic (third fragments-revision3)))))))
236      (is-false
237       (set-exclusive-or 
238        '("http://psi.egovpt.org/types/standard"
239          "http://psi.egovpt.org/types/links";)
240          "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
241          "http://www.topicmaps.org/xtm/1.0/core.xtm#display"
242          "http://psi.egovpt.org/types/long-name")
243        (remove-duplicates 
244         (map 'list 
245              #'uri 
246              (mapcan #'psis (referenced-topics (third fragments-revision3))))
247         :test #'string=)
248        :test #'string=))
249      ;0 if we ignore instanceOf associations
250      (is (= 0 (length (associations (third fragments-revision3)))))
251      (is (string= 
252           "http://psi.egovpt.org/service/Norwegian+National+Curriculum"
253           (uri (first (psis (topic (second fragments-revision3)))))))
254      (is-false
255       (set-exclusive-or 
256        '("http://psi.egovpt.org/types/service"
257          "http://psi.egovpt.org/types/description"
258          "http://psi.egovpt.org/types/links"
259          "http://psi.egovpt.org/types/serviceUsesStandard"
260          "http://psi.egovpt.org/types/StandardRoleType"
261          "http://psi.egovpt.org/standard/Topic+Maps+2002"
262          "http://psi.egovpt.org/types/ServiceRoleType"
263          ;these three PSIS all stand for the same topic
264          "http://psi.egovpt.org/types/semanticstandard"
265          "http://psi.egovpt.org/types/greatstandard"
266          "http://psi.egovpt.org/types/knowledgestandard")
267        (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (second fragments-revision3))))
268                           :test #'string=)
269        :test #'string=))
270      ;the second time round the object should be fetched from the
271      ;cache
272      (is (equal fragments-revision3 
273                 (get-fragments fixtures::revision3))))))
274
275
276(test test-changed-p ()
277  "Check the is-changed mechanism"
278  (with-fixture merge-test-db ()
279    (let*
280        ((service-topic ;changed in merge1
281          (get-item-by-id "t2" :xtm-id *TEST-TM* :revision fixtures::revision1))
282         (service-name ;does not change after creation
283          (first (names service-topic :revision fixtures::revision1)))
284         (google-maps-topic        ;does not change after creation
285          (get-item-by-id "t301a" :xtm-id *TEST-TM* :revision fixtures::revision1))
286         (norwegian-curr-topic    ;changes in merge1 (only through
287                                        ;association) and merge2 (again through association)
288          (get-item-by-id "t300" :xtm-id *TEST-TM* :revision fixtures::revision1))
289         (geodata-topic             ;does not change after creation
290          (get-item-by-id "t203" :xtm-id *TEST-TM* :revision fixtures::revision1)) ;the subject "geodata", not the standard
291         (semantic-standard-topic   ;changes in merge1 and merge2
292          (get-item-by-id "t3a" :xtm-id *TEST-TM* :revision fixtures::revision1))
293         (common-lisp-topic ;created in merge1 and changed in merge2
294          (get-item-by-id "t100" :xtm-id "merge1" :revision fixtures::revision2))
295         (subject-geodata-assoc    ;does not change after creation
296          (parent 
297           (second    ;the first one is the instanceOf association
298            (player-in-roles
299             geodata-topic :revision fixtures::revision1))
300           :revision fixtures::revision1))
301         (norwegian-curriculum-assoc    ;changes in merge1 and merge2
302          (identified-construct
303           (elephant:get-instance-by-value
304            'ItemIdentifierC 'uri 
305            "http://psi.egovpt.org/itemIdentifiers#assoc_6")
306           :revision fixtures::revision2)))
307      (is-true (changed-p service-name fixtures::revision1))
308      (is-false (changed-p service-name fixtures::revision2))
309      (is-false (changed-p service-name fixtures::revision3))
310      (is-true (changed-p service-topic fixtures::revision1))
311      (is-true (changed-p service-topic fixtures::revision2))
312      (is-false (changed-p service-topic fixtures::revision3))
313      (is-true (changed-p google-maps-topic fixtures::revision1))
314      (is-false (changed-p google-maps-topic fixtures::revision2))
315      (is-false (changed-p google-maps-topic fixtures::revision3))
316      (is-true (changed-p norwegian-curr-topic fixtures::revision1))
317      (is-true (changed-p norwegian-curr-topic fixtures::revision2))
318      (is-true (changed-p norwegian-curr-topic fixtures::revision3))
319      (is-true (changed-p geodata-topic fixtures::revision1))
320      (is-false (changed-p geodata-topic fixtures::revision2))
321      (is-false (changed-p geodata-topic fixtures::revision3))
322      (is-true (changed-p semantic-standard-topic fixtures::revision1))
323      (is-true (changed-p semantic-standard-topic fixtures::revision2))
324      (is-true (changed-p semantic-standard-topic fixtures::revision3))
325      (is-false (changed-p common-lisp-topic fixtures::revision1)) ;didn't even exist then
326      (is-true (changed-p common-lisp-topic fixtures::revision2))
327      (is-true (changed-p common-lisp-topic fixtures::revision3))
328      (is-true (changed-p subject-geodata-assoc fixtures::revision1))
329      (is-false (changed-p subject-geodata-assoc fixtures::revision2))
330      (is-false (changed-p subject-geodata-assoc fixtures::revision3))
331      (is-true (changed-p norwegian-curriculum-assoc fixtures::revision1))
332      (is-true (changed-p norwegian-curriculum-assoc fixtures::revision2))
333      (is-true (changed-p norwegian-curriculum-assoc fixtures::revision3))
334      (delete-name service-topic service-name :revision fixtures::revision3)
335      (is-true (changed-p service-topic fixtures::revision3)))))
336
337
338(test test-mark-as-deleted ()
339  "Check the pseudo-deletion mechanism"
340  (with-fixture merge-test-db ()
341    (let
342        ((norwegian-curriculum-topic
343          (get-item-by-psi "http://psi.egovpt.org/service/Norwegian+National+Curriculum"
344                           :revision fixtures::revision3))
345         (semantic-standard-topic
346          (get-item-by-psi "http://psi.egovpt.org/types/semanticstandard"
347                           :revision fixtures::revision3)))
348      (is-true norwegian-curriculum-topic)
349      (is-true semantic-standard-topic)
350      (mark-as-deleted norwegian-curriculum-topic
351                       :source-locator "http://psi.egovpt.org/"
352                       :revision fixtures::revision3)
353      (is-false (get-item-by-psi
354                 "http://psi.egovpt.org/service/Norwegian+National+Curriculum"
355                 :revision (1+ fixtures::revision3)))
356      (mark-as-deleted semantic-standard-topic
357                       :source-locator "http://blablub.egovpt.org/"
358                       :revision fixtures::revision3)
359      (is-true (get-item-by-psi "http://psi.egovpt.org/types/semanticstandard"
360                                :revision (1+ fixtures::revision3)))
361      (is (= 0 (d::end-revision
362                (d::get-most-recent-version-info semantic-standard-topic))))
363      (is (= (d::end-revision
364              (first (last (d::versions norwegian-curriculum-topic))))
365             (d::end-revision
366              (d::get-most-recent-version-info norwegian-curriculum-topic)))))))
367
368
369
370(defun run-versions-tests()
371  (it.bese.fiveam:run! 'test-get-item-by-id-t100)
372  (it.bese.fiveam:run! 'test-get-item-by-id-t301)
373  (it.bese.fiveam:run! 'test-norwegian-curriculum-association)
374  (it.bese.fiveam:run! 'test-instance-of-t64)
375  (it.bese.fiveam:run! 'test-change-lists)
376  (it.bese.fiveam:run! 'test-changed-p)
377  (it.bese.fiveam:run! 'test-mark-as-deleted))
Note: See TracBrowser for help on using the repository browser.