source: trunk/src/unit_tests/sparql_test.lisp

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

fixed ticket #111 and adapted all unit-tests

File size: 107.2 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4;;+
5;;+  Isidorus is freely distributable under the LLGPL license.
6;;+  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7;;+  trunk/docs/LGPL-LICENSE.txt.
8;;+-----------------------------------------------------------------------------
9
10(defpackage :sparql-test
11  (:use  :cl
12         :base-tools
13         :it.bese.FiveAM
14         :TM-SPARQL
15         :exceptions
16         :unittests-constants
17         :fixtures
18         :d
19         :constants
20         :tm-sparql-constants)
21  (:export :run-sparql-tests
22           :sparql-tests
23           :test-prefix-and-base
24           :test-variable-names
25           :test-parse-literals
26           :test-parse-triple-elem
27           :test-parse-group-1
28           :test-parse-group-2
29           :test-set-result-1
30           :test-set-result-2
31           :test-set-result-3
32           :test-set-result-4
33           :test-set-result-5
34           :test-result
35           :test-set-boundings
36           :test-set-unary-operators
37           :test-set-or-and-operators
38           :test-set-*-and-/-operators
39           :test-set-+-and---operators
40           :test-set-compare-operators
41           :test-set-functions
42           :test-module-1
43           :test-module-2
44           :test-module-3
45           :test-module-4
46           :test-module-5
47           :test-module-6
48           :test-module-7
49           :test-module-8
50           :test-module-9
51           :test-module-10
52           :test-module-11
53           :test-module-12
54           :test-module-13
55           :test-module-14
56           :test-module-15
57           :test-module-16
58           :test-module-17))
59
60
61(in-package :sparql-test)
62
63
64(def-suite sparql-tests
65     :description "tests  various key functions of the TM-SPARQL module")
66
67(in-suite sparql-tests)
68
69
70(test test-prefix-and-base
71  "Tests the sparql parser when parsing PREFIX and BASE statements."
72  (let* ((query-1 "PREFIX foaf  :   <http://xmlns.com/foaf/0.1/>
73                   PREFIX org:    <http://example.com/ns#>
74                   PREFIX isi:<http://isidor.us>
75                   PREFIX :<http://some.where>
76                   BASE      <http://base.one>
77                   PREFIX foaf : <http://overwrite.foaf>
78                   BASE<http://base.two>")
79         (query-2 "PREFIX foaf  :   <http://xmlns.com/foaf/0.1/>
80                   PREFIX org:
81<http://example.com/ns#>
82                   PREFIX isi:<http://isidor.us>
83                   PREFIX
84:<http://some.where>
85                   BASE      <http://base.one>
86                   PREFIX foaf : <http://overwrite.foaf>
87                   BASE<http://base.two>")
88         (query-object-1 (make-instance 'SPARQL-Query :query query-1))
89         (query-object-2 (make-instance 'SPARQL-Query :query query-2
90                                        :base "http://any-base")))
91    (signals missing-argument-error (make-instance 'SPARQL-Query))
92    (is-true query-object-1)
93    (is-true query-object-2)
94    (is (string= (TM-SPARQL::base-value query-object-1) "http://base.two"))
95    (is (string= (TM-SPARQL::base-value query-object-2) "http://base.two"))
96    (is (= (length (TM-SPARQL::prefixes query-object-1)) 4))
97    (is (= (length (TM-SPARQL::prefixes query-object-2)) 4))
98    (is-true (find-if #'(lambda(elem)
99                          (and (string= (getf elem :label) "foaf")
100                               (string= (getf elem :value)
101                                        "http://overwrite.foaf")))
102                      (TM-SPARQL::prefixes query-object-1)))
103    (is-true (find-if #'(lambda(elem)
104                          (and (string= (getf elem :label) "org")
105                               (string= (getf elem :value)
106                                        "http://example.com/ns#")))
107                      (TM-SPARQL::prefixes query-object-1)))
108    (is-true (find-if #'(lambda(elem)
109                          (and (string= (getf elem :label) "isi")
110                               (string= (getf elem :value)
111                                        "http://isidor.us")))
112                      (TM-SPARQL::prefixes query-object-1)))
113    (is-true (find-if #'(lambda(elem)
114                          (and (string= (getf elem :label)
115                                        TM-SPARQL::*empty-label*)
116                               (string= (getf elem :value)
117                                        "http://some.where")))
118                      (TM-SPARQL::prefixes query-object-1)))
119    (is-true (find-if #'(lambda(elem)
120                          (and (string= (getf elem :label) "foaf")
121                               (string= (getf elem :value)
122                                        "http://overwrite.foaf")))
123                      (TM-SPARQL::prefixes query-object-2)))
124    (is-true (find-if #'(lambda(elem)
125                          (and (string= (getf elem :label) "org")
126                               (string= (getf elem :value)
127                                        "http://example.com/ns#")))
128                      (TM-SPARQL::prefixes query-object-2)))
129    (is-true (find-if #'(lambda(elem)
130                          (and (string= (getf elem :label) "isi")
131                               (string= (getf elem :value)
132                                        "http://isidor.us")))
133                      (TM-SPARQL::prefixes query-object-2)))
134    (is-true (find-if #'(lambda(elem)
135                          (and (string= (getf elem :label)
136                                        TM-SPARQL::*empty-label*)
137                               (string= (getf elem :value)
138                                        "http://some.where")))
139                      (TM-SPARQL::prefixes query-object-2)))))
140
141
142(test test-variable-names
143  "Tests the sparql parser when parsing variables in the SELECT statement."
144  (let* ((query-1 "PREFIX foaf  :   <http://xmlns.com/foaf/0.1/>
145                   PREFIX org:    <http://example.com/ns#>
146                   PREFIX isi:<http://isidor.us>
147                   PREFIX :<http://some.where>
148                   BASE      <http://base.one>
149                   PREFIX foaf : <http://overwrite.foaf>
150                   BASE<http://base.two>
151                   SELECT ?var1$var2
152$var3 ?var3 WHERE{}")
153         (query-2 "SELECT ?var1$var2 $var3 ?var3 WHERE{}")
154         (query-3 "SELECT ?var1$var2 $var3 ?var3WHERE{}")
155         (query-4 "SELECT * WHERE{}")
156         (query-object-1 (make-instance 'SPARQL-Query :query query-1))
157         (query-object-2 (make-instance 'SPARQL-Query :query query-2))
158         (query-object-3 (make-instance 'SPARQL-QUERY :query query-4)))
159    (is-true query-object-1)
160    (is-true query-object-2)
161    (is-true query-object-3)
162    (signals sparql-parser-error (make-instance 'SPARQL-Query :query query-3))
163    (is (= (length (TM-SPARQL::variables query-object-1)) 3))
164    (is-true (find "var1" (TM-SPARQL::variables query-object-1)
165                   :test #'string=))
166    (is-true (find "var2" (TM-SPARQL::variables query-object-1)
167                   :test #'string=))
168    (is-true (find "var3" (TM-SPARQL::variables query-object-1)
169                   :test #'string=))
170    (is (= (length (TM-SPARQL::variables query-object-2)) 3))
171    (is-true (find "var1" (TM-SPARQL::variables query-object-2)
172                   :test #'string=))
173    (is-true (find "var2" (TM-SPARQL::variables query-object-2)
174                   :test #'string=))
175    (is-true (find "var3" (TM-SPARQL::variables query-object-2)
176                   :test #'string=))
177    (is-true (find "*" (TM-SPARQL::variables query-object-3)
178                   :test #'string=))
179    (is-true (tm-sparql::*-p query-object-3))))
180
181
182(test test-parse-literals
183  "Tests the helper functions for parsing literals."
184  (let ((query-1 "   \"literal-value\"@de.")
185        (query-2 "true.")
186        (query-3 "false}")
187        (query-4 (concat "1234.43e10" (string #\tab)))
188        (query-5 (concat "'''true'''^^" *xml-boolean* " ;"))
189        (query-6 (concat "'123.4'^^" *xml-double* "." (string #\newline)))
190        (query-7 "\"Just a test
191
192literal with some \\\"quoted\\\" words!\"@en.")
193        (query-8 (concat "'''12.4'''^^" *xml-integer* ". "))
194        (query-9 (concat "\"13e4\"^^" *xml-boolean* " ."))
195        (dummy-object (make-instance 'SPARQL-Query :query "")))
196    (is-true dummy-object)
197    (let ((res (tm-sparql::parse-literal-elem dummy-object query-1)))
198      (is (string= (getf res :next-query) "."))
199      (is (string= (tm-sparql::value (getf res :value))
200                   "literal-value"))
201      (is (string= (tm-sparql::literal-lang (getf res :value))
202                   "de"))
203      (is (string= (tm-sparql::literal-datatype (getf res :value))
204                   *xml-string*))
205      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
206    (let ((res (tm-sparql::parse-literal-elem dummy-object query-2)))
207      (is (string= (getf res :next-query) "."))
208      (is (eql (tm-sparql::value (getf res :value)) t))
209      (is-false (tm-sparql::literal-lang (getf res :value)))
210      (is (string= (tm-sparql::literal-datatype (getf res :value))
211                   *xml-boolean*))
212      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
213    (let ((res (tm-sparql::parse-literal-elem dummy-object query-3)))
214      (is (string= (getf res :next-query) "}"))
215      (is (eql (tm-sparql::value (getf res :value)) nil))
216      (is-false (tm-sparql::literal-lang (getf res :value)))
217      (is (string= (tm-sparql::literal-datatype (getf res :value))
218                   *xml-boolean*))
219      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
220    (let ((res (tm-sparql::parse-literal-elem dummy-object query-4)))
221      (is (string= (getf res :next-query) (string #\tab)))
222      (is (= (tm-sparql::value (getf res :value)) 1234.43e10))
223      (is-false (tm-sparql::literal-lang (getf res :value)))
224      (is (string= (tm-sparql::literal-datatype (getf res :value))
225                   *xml-double*))
226      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
227    (let ((res (tm-sparql::parse-literal-elem dummy-object query-5)))
228      (is (string= (getf res :next-query) ";"))
229      (is (eql (tm-sparql::value (getf res :value)) t))
230      (is-false (tm-sparql::literal-lang (getf res :value)))
231      (is (string= (tm-sparql::literal-datatype (getf res :value))
232                   *xml-boolean*))
233      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
234    (let ((res (tm-sparql::parse-literal-elem dummy-object query-6)))
235      (is (string= (getf res :next-query)
236                   (concat "." (string #\newline))))
237      (is (eql (tm-sparql::value (getf res :value)) 123.4d0))
238      (is-false (tm-sparql::literal-lang (getf res :value)))
239      (is (string= (tm-sparql::literal-datatype (getf res :value))
240                   *xml-double*))
241      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
242    (let ((res (tm-sparql::parse-literal-elem dummy-object query-7)))
243      (is (string= (getf res :next-query) "."))
244      (is (string= (tm-sparql::value (getf res :value))
245                   "Just a test
246
247literal with some \\\"quoted\\\" words!"))
248      (is (string= (tm-sparql::literal-lang (getf res :value)) "en"))
249      (is (string= (tm-sparql::literal-datatype (getf res :value))
250                   *xml-string*))
251      (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL)))
252    (signals sparql-parser-error
253      (tm-sparql::parse-literal-elem dummy-object query-8))
254    (signals sparql-parser-error
255      (tm-sparql::parse-literal-elem dummy-object query-9))))
256
257
258(test test-parse-triple-elem
259  "Tests various functionality of the parse-triple-elem function."
260  (let ((query-1 "?var1   .")
261        (query-2 "$var2 ;")
262        (query-3 "$var3 }")
263        (query-4 "<http://full.url>.")
264        (query-5 "<url-suffix>  }")
265        (query-6 "pref:suffix  .")
266        (query-7 "pref:suffix}")
267        (query-8 "preff:suffix}")
268        (dummy-object (make-instance 'SPARQL-Query :query ""
269                                     :base "http://base.value"))
270        (var 'TM-SPARQL::VARIABLE)
271        (iri 'TM-SPARQL::IRI))
272    (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value")
273    (let ((res (tm-sparql::parse-triple-elem dummy-object query-1)))
274      (is (string= (getf res :next-query) "."))
275      (is (string= (tm-sparql::value (getf res :value)) "var1"))
276      (is (eql (tm-sparql::elem-type (getf res :value)) var)))
277    (let ((res (tm-sparql::parse-triple-elem dummy-object query-2)))
278      (is (string= (getf res :next-query) ";"))
279      (is (string= (tm-sparql::value (getf res :value)) "var2"))
280      (is (eql (tm-sparql::elem-type (getf res :value)) var)))
281    (let ((res (tm-sparql::parse-triple-elem dummy-object query-3)))
282      (is (string= (getf res :next-query) "}"))
283      (is (string= (tm-sparql::value (getf res :value)) "var3"))
284      (is (eql (tm-sparql::elem-type (getf res :value)) var)))
285    (let ((res (tm-sparql::parse-triple-elem dummy-object query-4)))
286      (is (string= (getf res :next-query) "."))
287      (is (string= (tm-sparql::value (getf res :value))
288                   "http://full.url"))
289      (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
290    (let ((res (tm-sparql::parse-triple-elem dummy-object query-5)))
291      (is (string= (getf res :next-query) "}"))
292      (is (string= (tm-sparql::value (getf res :value))
293                   "http://base.value/url-suffix"))
294      (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
295    (let ((res (tm-sparql::parse-triple-elem dummy-object query-6)))
296      (is (string= (getf res :next-query) "."))
297      (is (string= (tm-sparql::value (getf res :value))
298                   "http://prefix.value/suffix"))
299      (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
300    (let ((res (tm-sparql::parse-triple-elem dummy-object query-7)))
301      (is (string= (getf res :next-query) "}"))
302      (is (string= (tm-sparql::value (getf res :value))
303                   "http://prefix.value/suffix"))
304      (is (eql (tm-sparql::elem-type (getf res :value)) iri)))
305    (signals sparql-parser-error 
306      (tm-sparql::parse-triple-elem dummy-object query-8))))
307
308
309(test test-parse-group-1
310  "Test various functionality of several functions responsible for parsing
311   the SELECT-WHERE-statement."
312  (let ((query-1 "?subject ?predicate $object }")
313        (query-2 "<subject> pref:predicate 1234.5e12}")
314        (query-3 "pref:subject ?predicate 'literal'@en}")
315        (dummy-object (make-instance 'SPARQL-Query :query ""
316                                     :base "http://base.value/"))
317        (var 'TM-SPARQL::VARIABLE)
318        (lit 'TM-SPARQL::LITERAL)
319        (iri 'TM-SPARQL::IRI))
320    (is-true dummy-object)
321    (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/")
322    (is (string= (tm-sparql::parse-triple dummy-object query-1) ""))
323    (is (= (length (tm-sparql::select-group dummy-object)) 1))
324    (let ((elem (first (tm-sparql::select-group dummy-object))))
325      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) var))
326      (is (string= (tm-sparql::value (tm-sparql::subject elem)) "subject"))
327      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var))
328      (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "predicate"))
329      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) var))
330      (is (string= (tm-sparql::value (tm-sparql::object elem)) "object")))
331    (is (string= (tm-sparql::parse-triple dummy-object query-2) ""))
332    (is (= (length (tm-sparql::select-group dummy-object)) 2))
333    (let ((elem (first (tm-sparql::select-group dummy-object))))
334      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
335      (is (string= (tm-sparql::value (tm-sparql::subject elem))
336                   "http://base.value/subject"))
337      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri))
338      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
339                   "http://prefix.value/predicate"))
340      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
341      (is (= (tm-sparql::value (tm-sparql::object elem)) 1234.5e12))
342      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
343                   *xml-double*))
344      (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))
345    (is (string= (tm-sparql::parse-triple dummy-object query-3) ""))
346    (is (= (length (tm-sparql::select-group dummy-object)) 3))
347    (let ((elem (first (tm-sparql::select-group dummy-object))))
348      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
349      (is (string= (tm-sparql::value (tm-sparql::subject elem))
350                   "http://prefix.value/subject"))
351      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var))
352      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
353                   "predicate"))
354      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
355      (is (string= (tm-sparql::value (tm-sparql::object elem)) "literal"))
356      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
357                   *xml-string*))
358      (is (string= (tm-sparql::literal-lang (tm-sparql::object elem)) "en")))))
359
360
361(test test-parse-group-2
362  "Test various functionality of several functions responsible for parsing
363   the SELECT-WHERE-statement."
364  (let ((query-4 (concat "<subject> <predicate> '''true'''^^"
365                         *xml-boolean* "; pref:predicate-2 \"12\"^^"
366                         *xml-integer* "}"))
367        (query-5 (concat "<subject> <predicate> '''false'''^^"
368                         *xml-boolean* "; BASE <http://new.base/>"
369                         "<predicate-2> \"abc\"^^"
370                         *xml-string* "}"))
371        (dummy-object (make-instance 'SPARQL-Query :query ""
372                                     :base "http://base.value/"))
373        (lit 'TM-SPARQL::LITERAL)
374        (iri 'TM-SPARQL::IRI))
375    (is-true dummy-object)
376    (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/")
377    (is (string= (tm-sparql::parse-group dummy-object query-4) ""))
378    (is (= (length (tm-sparql::select-group dummy-object)) 2))
379    (let ((elem (second (tm-sparql::select-group dummy-object))))
380      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
381      (is (string= (tm-sparql::value (tm-sparql::subject elem))
382                   "http://base.value/subject"))
383      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri))
384      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
385                   "http://base.value/predicate"))
386      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
387      (is (eql (tm-sparql::value (tm-sparql::object elem)) t))
388      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
389                   *xml-boolean*))
390      (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))
391    (let ((elem (first (tm-sparql::select-group dummy-object))))
392      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
393      (is (string= (tm-sparql::value (tm-sparql::subject elem))
394                   "http://base.value/subject"))
395      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri))
396      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
397                   "http://prefix.value/predicate-2"))
398      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
399      (is (= (tm-sparql::value (tm-sparql::object elem)) 12))
400      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
401                   *xml-integer*))
402      (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))
403    (is (string= "http://base.value/" (tm-sparql::base-value dummy-object)))
404    (is (string= (tm-sparql::parse-group dummy-object query-5) ""))
405    (is (= (length (tm-sparql::select-group dummy-object)) 4))
406    (is (string= "http://new.base/" (tm-sparql::base-value dummy-object)))
407    (let ((elem (second (tm-sparql::select-group dummy-object))))
408      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
409      (is (string= (tm-sparql::value (tm-sparql::subject elem))
410                   "http://base.value/subject"))
411      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri))
412      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
413                   "http://base.value/predicate"))
414      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
415      (is (eql (tm-sparql::value (tm-sparql::object elem)) nil))
416      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
417                   *xml-boolean*))
418      (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))
419    (let ((elem (first (tm-sparql::select-group dummy-object))))
420      (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri))
421      (is (string= (tm-sparql::value (tm-sparql::subject elem))
422                   "http://base.value/subject"))
423      (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri))
424      (is (string= (tm-sparql::value (tm-sparql::predicate elem))
425                   "http://new.base/predicate-2"))
426      (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit))
427      (is (string= (tm-sparql::value (tm-sparql::object elem)) "abc"))
428      (is (string= (tm-sparql::literal-datatype (tm-sparql::object elem))
429                   *xml-string*))
430      (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))))
431
432
433(test test-set-result-1
434  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
435    (with-revision 0
436      (let* ((query-1 "BASE <http://some.where/>
437                       SELECT ?subject ?predicate ?object WHERE {
438                         ?subject ?predicate ?object }")
439             (query-2 "BASE <http://some.where/psis/poem/>
440                       SELECT $subject ?predicate WHERE{
441                         ?subject $predicate <zauberlehrling> }")
442             (query-3 "SELECT ?predicate ?subject WHERE
443                         {?subject ?predicate \"Johann Wolfgang\" }")
444             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
445             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
446             (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
447        (is-true q-obj-1)
448        (is (= (length (tm-sparql::select-group q-obj-1)) 1))
449        (is-true q-obj-2)
450        (is (= (length (tm-sparql::select-group q-obj-2)) 1))
451        (is-true q-obj-3)
452        (is (= (length (tm-sparql::select-group q-obj-3)) 1))
453        (is-true (tm-sparql::subject-result
454                   (first (tm-sparql::select-group q-obj-1))))
455        (is-true (tm-sparql::predicate-result
456                   (first (tm-sparql::select-group q-obj-1))))
457        (is-true (tm-sparql::object-result
458                   (first (tm-sparql::select-group q-obj-1))))
459        (is (= (length (tm-sparql::subject-result
460                        (first (tm-sparql::select-group q-obj-2)))) 2))
461        (is (= (length (tm-sparql::predicate-result
462                        (first (tm-sparql::select-group q-obj-2)))) 2))
463        (is (= (length (tm-sparql::object-result
464                        (first (tm-sparql::select-group q-obj-2)))) 2))
465        (let ((subj-1 (first (tm-sparql::subject-result
466                              (first (tm-sparql::select-group q-obj-2)))))
467              (subj-2 (second (tm-sparql::subject-result
468                               (first (tm-sparql::select-group q-obj-2)))))
469              (pred-1 (first (tm-sparql::predicate-result
470                              (first (tm-sparql::select-group q-obj-2)))))
471              (pred-2 (second (tm-sparql::predicate-result
472                               (first (tm-sparql::select-group q-obj-2)))))
473              (obj-1 (first (tm-sparql::object-result
474                              (first (tm-sparql::select-group q-obj-2)))))
475              (obj-2 (second (tm-sparql::object-result
476                               (first (tm-sparql::select-group q-obj-2))))))
477          (cond ((or (string= subj-1 "<http://some.where/psis/author/goethe>")
478                     (string= subj-1 "<http://some.where/psis/persons/goethe>"))
479                 (is (string= pred-1 "<http://some.where/base-psis/written>"))
480                 (is (or (string= obj-1 "<http://some.where/psis/poem/zauberlehrling>")
481                         (string= obj-1 "<http://some.where/psis/der_zauberlehrling>")))
482                 (is (string= subj-2 "<http://some.where/base-psis/poem>"))
483                 (is (string= pred-2 "<http://psi.topicmaps.org/iso13250/model/instance>"))
484                 (is (or (string= obj-2 "<http://some.where/psis/poem/zauberlehrling>")
485                         (string= obj-2 "<http://some.where/psis/der_zauberlehrling>"))))
486                ((string= subj-1 "<http://some.where/base-psis/poem>")
487                 (is (string= pred-2 "<http://some.where/base-psis/written>"))
488                 (is (or (string= obj-1 "<http://some.where/psis/poem/zauberlehrling>")
489                         (string= obj-1 "<http://some.where/psis/der_zauberlehrling>")))
490                 (is (or (string= subj-2 "<http://some.where/psis/author/goethe>")
491                         (string= subj-2 "<http://some.where/psis/persons/goethe>")))
492                 (is (string= pred-1 "<http://psi.topicmaps.org/iso13250/model/instance>"))
493                 (is (or (string= obj-2 "<http://some.where/psis/poem/zauberlehrling>")
494                         (string= obj-2 "<http://some.where/psis/der_zauberlehrling>"))))
495                (t
496                 (is-true nil))))
497        (is (= (length (tm-sparql::subject-result
498                        (first (tm-sparql::select-group q-obj-3)))) 1))
499        (is (= (length (tm-sparql::predicate-result
500                        (first (tm-sparql::select-group q-obj-3)))) 1))
501        (is (= (length (tm-sparql::object-result
502                        (first (tm-sparql::select-group q-obj-3)))) 1))
503        (is (or (string= (first (tm-sparql::subject-result
504                                 (first (tm-sparql::select-group q-obj-3))))
505                         "<http://some.where/psis/author/goethe>")
506                (string= (first (tm-sparql::subject-result
507                                 (first (tm-sparql::select-group q-obj-3))))
508                         "<http://some.where/psis/persons/goethe>")))
509        (is (string= (first (tm-sparql::predicate-result
510                             (first (tm-sparql::select-group q-obj-3))))
511                     "<http://some.where/base-psis/first-name>"))
512        (is (string= (first (tm-sparql::object-result
513                             (first (tm-sparql::select-group q-obj-3))))
514                     "Johann Wolfgang"))))))
515
516
517(test test-set-result-2
518  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
519    (with-revision 0
520      (let* ((query-1 "PREFIX pref:<http://some.where/base-psis/>
521                       SELECT $subject $object WHERE {
522                         ?subject pref:written ?object }")
523             (query-2 "BASE <http://some.where/base-psis/>
524                       SELECT $subject $object WHERE {
525                         ?subject <first-name> ?object }")
526             (query-3 "BASE <http://some.where/psis/>
527                       SELECT ?subject WHERE{
528                         ?subject <http://some.where/base-psis/written>
529                           <poem/zauberlehrling>}")
530             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
531             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
532             (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
533        (is-true q-obj-1)
534        (is-true q-obj-2)
535        (is-true q-obj-3)
536        (is (= (length (tm-sparql::select-group q-obj-1)) 1))
537        (is (= (length (tm-sparql::subject-result
538                        (first (tm-sparql::select-group q-obj-1)))) 4))
539        (is (= (length (tm-sparql::predicate-result
540                        (first (tm-sparql::select-group q-obj-1)))) 4))
541        (is (= (length (tm-sparql::object-result
542                        (first (tm-sparql::select-group q-obj-1)))) 4))
543        (let* ((s-1 (first (tm-sparql::subject-result
544                            (first (tm-sparql::select-group q-obj-1)))))
545               (s-2 (second (tm-sparql::subject-result
546                             (first (tm-sparql::select-group q-obj-1)))))
547               (s-3 (third (tm-sparql::subject-result
548                            (first (tm-sparql::select-group q-obj-1)))))
549               (s-4 (fourth (tm-sparql::subject-result
550                             (first (tm-sparql::select-group q-obj-1)))))
551               (p-1 (first (tm-sparql::predicate-result
552                            (first (tm-sparql::select-group q-obj-1)))))
553               (p-2 (second (tm-sparql::predicate-result
554                             (first (tm-sparql::select-group q-obj-1)))))
555               (p-3 (third (tm-sparql::predicate-result
556                            (first (tm-sparql::select-group q-obj-1)))))
557               (p-4 (fourth (tm-sparql::predicate-result
558                             (first (tm-sparql::select-group q-obj-1)))))
559               (o-1 (first (tm-sparql::object-result
560                            (first (tm-sparql::select-group q-obj-1)))))
561               (o-2 (second (tm-sparql::object-result
562                            (first (tm-sparql::select-group q-obj-1)))))
563               (o-3 (third (tm-sparql::object-result
564                            (first (tm-sparql::select-group q-obj-1)))))
565               (o-4 (fourth (tm-sparql::object-result
566                             (first (tm-sparql::select-group q-obj-1))))))
567          (is (string= p-1 "<http://some.where/base-psis/written>"))
568          (is (string= p-2 "<http://some.where/base-psis/written>"))
569          (is (string= p-3 "<http://some.where/base-psis/written>"))
570          (is (string= p-4 "<http://some.where/base-psis/written>"))
571          (is (or (not (set-exclusive-or
572                        (list "<http://some.where/psis/author/eichendorff>"
573                              "<http://some.where/psis/author/schiller>"
574                              "<http://some.where/psis/author/goethe>")
575                        (list s-1 s-2 s-3 s-4)
576                        :test #'string=))
577                  (not (set-exclusive-or
578                        (list "<http://some.where/psis/author/eichendorff>"
579                              "<http://some.where/psis/author/schiller>"
580                              "<http://some.where/psis/persons/goethe>")
581                        (list s-1 s-2 s-3 s-4)
582                        :test #'string=))))
583          (is-false (set-exclusive-or
584                     (list "<http://some.where/psis/poem/mondnacht>"
585                           "<http://some.where/psis/poem/resignation>"
586                           "<http://some.where/psis/poem/erlkoenig>"
587                           "<http://some.where/psis/poem/zauberlehrling>")
588                     (list o-1 o-2 o-3 o-4)
589                     :test #'string=)))
590        (is-true q-obj-2)
591        (is (= (length (tm-sparql::subject-result
592                        (first (tm-sparql::select-group q-obj-2)))) 3))
593        (is (= (length (tm-sparql::predicate-result
594                        (first (tm-sparql::select-group q-obj-2)))) 3))
595        (is (= (length (tm-sparql::object-result
596                        (first (tm-sparql::select-group q-obj-2)))) 3))
597        (let* ((s-1 (first (tm-sparql::subject-result
598                            (first (tm-sparql::select-group q-obj-2)))))
599               (s-2 (second (tm-sparql::subject-result
600                             (first (tm-sparql::select-group q-obj-2)))))
601               (s-3 (third (tm-sparql::subject-result
602                            (first (tm-sparql::select-group q-obj-2)))))
603               (p-1 (first (tm-sparql::predicate-result
604                            (first (tm-sparql::select-group q-obj-2)))))
605               (p-2 (second (tm-sparql::predicate-result
606                             (first (tm-sparql::select-group q-obj-2)))))
607               (p-3 (third (tm-sparql::predicate-result
608                            (first (tm-sparql::select-group q-obj-2)))))
609               (o-1 (first (tm-sparql::object-result
610                            (first (tm-sparql::select-group q-obj-2)))))
611               (o-2 (second (tm-sparql::object-result
612                            (first (tm-sparql::select-group q-obj-2)))))
613               (o-3 (third (tm-sparql::object-result
614                            (first (tm-sparql::select-group q-obj-2))))))
615          (string= p-1 "<http://some.where/base-psis/first-name>")
616          (string= p-2 "<http://some.where/base-psis/first-name>")
617          (string= p-3 "<http://some.where/base-psis/first-name>")
618          (cond ((string= o-1 "Johann Christoph Friedrich")
619                 (is (string= s-1 "<http://some.where/psis/author/schiller>"))
620                 (cond ((string= o-2 "Johann Wolfgang")
621                        (is (or (string= s-2 "<http://some.where/psis/author/goethe>")
622                                (string= s-2 "<http://some.where/psis/persons/goethe>")))
623                        (is (string= s-3 "<http://some.where/psis/author/eichendorff>"))
624                        (is (string= o-3 "Joseph Karl Benedikt")))
625                       ((string= o-2 "Joseph Karl Benedikt")
626                        (is (string= s-2 "<http://some.where/psis/author/eichendorff>"))
627                        (is (or (string= s-3 "<http://some.where/psis/author/goethe>")
628                                (string= s-3 "<http://some.where/psis/persons/goethe>")))
629                        (is (string= o-3 "Johann Wolfgang")))
630                       (t
631                        (is-true nil))))
632                ((string= o-1 "Johann Wolfgang")
633                 (is (or (string= s-1 "<http://some.where/psis/author/goethe>")
634                         (string= s-1 "<http://some.where/psis/persons/goethe>")))
635                 (cond ((string= o-2 "Johann Christoph Friedrich")
636                        (is (string= s-2 "<http://some.where/psis/author/schiller>"))
637                        (is (string= s-3 "<http://some.where/psis/author/eichendorff>"))
638                        (is (string= o-3 "Joseph Karl Benedikt")))
639                       ((string= o-2 "Joseph Karl Benedikt")
640                        (is (string= s-2 "<http://some.where/psis/author/eichendorff>"))
641                        (is (string= s-3 "<http://some.where/psis/author/schiller>"))
642                        (is (string= o-3 "Johann Christoph Friedrich")))
643                       (t
644                        (is-true nil))))
645                ((string= o-1 "Joseph Karl Benedikt")
646                 (is (string= s-1 "<http://some.where/psis/author/eichendorff>"))
647                 (cond ((string= o-2 "Johann Wolfgang")
648                        (is (or (string= s-2 "<http://some.where/psis/author/goethe>")
649                                (string= s-2 "<http://some.where/psis/persons/goethe>")))
650                        (is (string= s-3 "<http://some.where/psis/author/schiller>"))
651                        (is (string= o-3 "Johann Christoph Friedrich")))
652                       ((string= o-2 "Johann Christoph Friedrich")
653                        (is (string= s-2 "<http://some.where/psis/author/schiller>"))
654                        (is (or (string= s-3 "<http://some.where/psis/author/goethe>")
655                                (string= s-3 "<http://some.where/psis/persons/goethe>")))
656                        (is (string= o-3 "Johann Wolfgang")))
657                       (t
658                        (is-true nil))))
659                (t
660                 (is-true nil))))
661        (is-true q-obj-3)
662        (is (= (length (tm-sparql::select-group q-obj-3)) 1))
663        (is (= (length (tm-sparql::subject-result
664                        (first (tm-sparql::select-group q-obj-3)))) 1))
665        (is (= (length (tm-sparql::predicate-result
666                        (first (tm-sparql::select-group q-obj-3)))) 1))
667        (is (= (length (tm-sparql::object-result
668                        (first (tm-sparql::select-group q-obj-3)))) 1))
669        (is (or (string= (first (tm-sparql::subject-result
670                                 (first (tm-sparql::select-group q-obj-3))))
671                         "<http://some.where/psis/author/goethe>")
672                (string= (first (tm-sparql::subject-result
673                                 (first (tm-sparql::select-group q-obj-3))))
674                         "<http://some.where/psis/persons/goethe>")))
675        (is (string= (first (tm-sparql::predicate-result
676                             (first (tm-sparql::select-group q-obj-3))))
677                     "<http://some.where/base-psis/written>"))
678        (is (string= (first (tm-sparql::object-result
679                             (first (tm-sparql::select-group q-obj-3))))
680                     "<http://some.where/psis/poem/zauberlehrling>"))))))
681
682
683(test test-set-result-3
684  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
685    (with-revision 0
686      (let* ((query-1 "PREFIX pref:<http://some.where/base-psis/>
687                       SELECT $subject WHERE {
688                         ?subject pref:author-info \"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe\"^^http://www.w3.org/2001/XMLSchema#anyURI }")
689             (query-2 "BASE <http://some.where/base-psis/>
690                       SELECT $subject WHERE {
691                         ?subject <last-name> 'von Goethe'^^anyType }")
692             (query-3 "BASE <http://some.where/base-psis/>
693                       SELECT ?subject WHERE{
694                         ?subject <http://some.where/base-psis/last-name>
695                           'Johann Wolfgang' }")
696             (query-4 "PREFIX pref-1:<http://some.where/base-psis/>
697                       PREFIX pref-2:<http://some.where/psis/>
698                       SELECT ?subject WHERE {
699                         ?subject pref-1:written pref-2:poem/resignation }")
700             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
701             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
702             (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))
703             (q-obj-4 (make-instance 'TM-SPARQL:SPARQL-Query :query query-4)))
704        (is-true q-obj-1)
705        (is-true q-obj-2)
706        (is-true q-obj-3)
707        (is-true q-obj-4)
708        (is (= (length (tm-sparql::select-group q-obj-1)) 1))
709        (is (= (length (tm-sparql::select-group q-obj-2)) 1))
710        (is (= (length (tm-sparql::select-group q-obj-3)) 1))
711        (is (= (length (tm-sparql::select-group q-obj-4)) 1))
712        (is (= (length (tm-sparql::predicate-result
713                        (first (tm-sparql::select-group q-obj-1)))) 1))
714        (is (= (length (tm-sparql::predicate-result
715                        (first (tm-sparql::select-group q-obj-2)))) 0))
716        (is (= (length (tm-sparql::predicate-result
717                        (first (tm-sparql::select-group q-obj-3)))) 0))
718        (is (or (string= (first (tm-sparql::subject-result
719                                 (first (tm-sparql::select-group q-obj-1))))
720                         "<http://some.where/psis/author/goethe>")
721                (string= (first (tm-sparql::subject-result
722                                 (first (tm-sparql::select-group q-obj-1))))
723                         "<http://some.where/psis/persons/goethe>")))
724        (is (string= (first (tm-sparql::predicate-result
725                             (first (tm-sparql::select-group q-obj-1))))
726                     "<http://some.where/base-psis/author-info>"))
727        (is (string= (first (tm-sparql::object-result
728                             (first (tm-sparql::select-group q-obj-1))))
729                     "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe"))
730        (is (string= (first (tm-sparql::subject-result
731                             (first (tm-sparql::select-group q-obj-4))))
732                     "<http://some.where/psis/author/schiller>"))
733        (is (string= (first (tm-sparql::predicate-result
734                             (first (tm-sparql::select-group q-obj-4))))
735                     "<http://some.where/base-psis/written>"))
736        (is (string= (first (tm-sparql::object-result
737                             (first (tm-sparql::select-group q-obj-4))))
738                     "<http://some.where/psis/poem/resignation>"))))))
739
740
741(test test-set-result-4
742  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
743    (with-revision 0
744      (let* ((query-1 "BASE <http://some.where/>
745                       SELECT ?predicate ?object WHERE {
746                         <psis/author/goethe> ?predicate ?object}")
747             (query-2 "BASE <http://some.where/>
748                       SELECT ?predicate ?object WHERE {
749                         <psis/poem/zauberlehrling> ?predicate ?object}")
750             (query-3 "BASE <http://some.where/>
751                       SELECT ?predicate WHERE {
752                         <psis/persons/goethe> ?predicate <psis/poem/zauberlehrling>}")
753             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
754             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
755             (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
756        (is-true q-obj-1)
757        (is-true q-obj-2)
758        (is-true q-obj-3)
759        (is (= (length (tm-sparql::select-group q-obj-1)) 1))
760        (is (= (length (tm-sparql::select-group q-obj-2)) 1))
761        (is (= (length (tm-sparql::select-group q-obj-3)) 1))
762        (is (= (length (tm-sparql::subject-result
763                        (first (tm-sparql::select-group q-obj-1)))) 7))
764        (is (= (length (tm-sparql::subject-result
765                        (first (tm-sparql::select-group q-obj-2)))) 4))
766        (is (= (length (tm-sparql::subject-result
767                        (first (tm-sparql::select-group q-obj-3)))) 1))
768        (is-true (or (null (set-exclusive-or
769                            (list "<http://some.where/psis/author/goethe>")
770                            (tm-sparql::subject-result
771                             (first (tm-sparql::select-group q-obj-1)))
772                            :test #'string=))
773                     (null (set-exclusive-or
774                            (list "<http://some.where/psis/persons/goethe>")
775                            (tm-sparql::subject-result
776                             (first (tm-sparql::select-group q-obj-1)))
777                            :test #'string=))))
778        (let ((predicates (tm-sparql::predicate-result
779                           (first (tm-sparql::select-group q-obj-1)))))
780          (is (= (count "<http://some.where/base-psis/written>" predicates
781                        :test #'string=) 2))
782          (is (= (count "<http://some.where/base-psis/place>" predicates
783                        :test #'string=) 1))
784          (is (= (count "<http://some.where/base-psis/first-name>" predicates
785                        :test #'string=) 1))
786          (is (= (count "<http://some.where/base-psis/last-name>" predicates
787                        :test #'string=) 1))
788          (is (= (count "<http://some.where/base-psis/author-info>" predicates
789                        :test #'string=) 1))
790          (is (= (count "<http://psi.topicmaps.org/iso13250/model/type>" predicates
791                        :test #'string=) 1)))
792        (let ((objects (tm-sparql::object-result
793                        (first (tm-sparql::select-group q-obj-1)))))
794          (is (= (count "<http://some.where/psis/poem/erlkoenig>" objects
795                        :test #'string=) 1))
796          (is (or (= (count "<http://some.where/psis/poem/der_zauberlehrling>"
797                            objects :test #'string=) 1)
798                  (= (count "<http://some.where/psis/poem/zauberlehrling>" objects
799                            :test #'string=) 1)))
800          (is (or (= (count "<http://some.where/base-psis/author>" objects
801                            :test #'string=) 1)
802                  (= (count "<http://some.where/base-psis/author-psi>" objects
803                            :test #'string=) 1)))
804          (is (= (count "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe"
805                        objects :test #'string=) 1))
806          (is (= (count "von Goethe" objects :test #'string=) 1))
807          (is (= (count "Johann Wolfgang" objects :test #'string=) 1))
808          (is (= (count "<http://some.where/psis/region/frankfurt_am_main>"
809                        objects :test #'string=) 1)))
810        (is-true (or (null (set-exclusive-or
811                            (list "<http://some.where/psis/poem/der_zauberlehrling>")
812                            (tm-sparql::subject-result
813                             (first (tm-sparql::select-group q-obj-2)))
814                            :test #'string=))
815                     (null (set-exclusive-or
816                            (list "<http://some.where/psis/poem/zauberlehrling>")
817                            (tm-sparql::subject-result
818                             (first (tm-sparql::select-group q-obj-2)))
819                            :test #'string=))))
820        (let ((predicates (tm-sparql::predicate-result
821                           (first (tm-sparql::select-group q-obj-2)))))
822          (is (= (count "<http://some.where/base-psis/writer>" predicates
823                        :test #'string=) 1))
824          (is (= (count "<http://some.where/base-psis/title>" predicates
825                        :test #'string=) 1))
826          (is (= (count "<http://some.where/base-psis/poem-content>" predicates
827                        :test #'string=) 1))
828          (is (= (count "<http://psi.topicmaps.org/iso13250/model/type>" predicates
829                        :test #'string=) 1)))
830        (let ((objects (tm-sparql::object-result
831                        (first (tm-sparql::select-group q-obj-2)))))
832          (is (or (= (count "<http://some.where/psis/author/goethe>" objects
833                            :test #'string=) 1)
834                  (= (count "<http://some.where/psis/persons/goethe>" objects
835                            :test #'string=) 1)))
836          (is (= (count "Der Zauberlehrling" objects :test #'string=) 1))
837          (is (= (count "<http://some.where/base-psis/poem>"
838                        objects :test #'string=) 1))
839          ;do not check the entire poem content => too long
840          )
841        (is (or (string= "<http://some.where/psis/author/goethe>"
842                         (first (tm-sparql::subject-result
843                                 (first (tm-sparql::select-group q-obj-3)))))
844                (string= "<http://some.where/psis/persons/goethe>"
845                         (first (tm-sparql::subject-result
846                                 (first (tm-sparql::select-group q-obj-3)))))))
847        (is (string= "<http://some.where/base-psis/written>"
848                     (first (tm-sparql::predicate-result
849                             (first (tm-sparql::select-group q-obj-3))))))
850        (is (or (string= "<http://some.where/psis/poem/der_zauberlehrling>"
851                         (first (tm-sparql::object-result
852                                 (first (tm-sparql::select-group q-obj-3)))))
853                (string= "<http://some.where/psis/poem/zauberlehrling>"
854                         (first (tm-sparql::object-result
855                                 (first (tm-sparql::select-group q-obj-3)))))))))))
856
857
858(test test-set-result-5
859  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
860    (with-revision 0
861      (let* ((query-1 "BASE <http://some.where/>
862                       SELECT ?predicate WHERE {
863                         <psis/author/goethe> ?predicate 'Johann Wolfgang'}")
864             (query-2 "BASE <http://some.where/>
865                       SELECT ?object WHERE {
866                         <psis/author/goethe> <base-psis/written> ?object}")
867             (query-3 "BASE <http://some.where/>
868                       SELECT ?object WHERE {
869                         <psis/persons/goethe> <base-psis/last-name> ?object.
870                         <does/not/exist> <any-predicate> ?object}")
871             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
872             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
873             (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
874        (is-true q-obj-1)
875        (is-true q-obj-2)
876        (is-true q-obj-3)
877        (is (= (length (tm-sparql::select-group q-obj-1)) 1))
878        (is (= (length (tm-sparql::select-group q-obj-2)) 1))
879        (is (= (length (tm-sparql::select-group q-obj-3)) 2))
880        (is (= (length (tm-sparql::subject-result
881                        (first (tm-sparql::select-group q-obj-1)))) 1))
882        (is (= (length (tm-sparql::subject-result
883                        (first (tm-sparql::select-group q-obj-2)))) 2))
884        (is (= (length (tm-sparql::subject-result
885                        (first (tm-sparql::select-group q-obj-3)))) 0))
886        (is (= (length (tm-sparql::subject-result
887                        (second (tm-sparql::select-group q-obj-3)))) 0))
888        (is (or (string= "<http://some.where/psis/author/goethe>"
889                         (first (tm-sparql::subject-result
890                                 (first (tm-sparql::select-group q-obj-1)))))
891                (string= "<http://some.where/psis/persons/goethe>"
892                         (first (tm-sparql::subject-result
893                                 (first (tm-sparql::select-group q-obj-1)))))))
894        (is (string= "<http://some.where/base-psis/first-name>"
895                     (first (tm-sparql::predicate-result
896                             (first (tm-sparql::select-group q-obj-1))))))
897        (is (string= "Johann Wolfgang"
898                     (first (tm-sparql::object-result
899                             (first (tm-sparql::select-group q-obj-1))))))
900        (is (or (string= "<http://some.where/psis/author/goethe>"
901                         (first (tm-sparql::subject-result
902                                 (first (tm-sparql::select-group q-obj-2)))))
903                (string= "<http://some.where/psis/persons/goethe>"
904                         (first (tm-sparql::subject-result
905                                 (first (tm-sparql::select-group q-obj-2)))))))
906        (is (string= "<http://some.where/base-psis/written>"
907                     (first (tm-sparql::predicate-result
908                             (first (tm-sparql::select-group q-obj-2))))))
909        (is (or (string= "<http://some.where/psis/poem/zauberlehrling>"
910                         (first (tm-sparql::object-result
911                                 (first (tm-sparql::select-group q-obj-2)))))
912                (string= "<http://some.where/psis/poem/der_zauberlehrling>"
913                         (first (tm-sparql::object-result
914                                 (first (tm-sparql::select-group q-obj-2)))))
915                (string= "<http://some.where/psis/poem/erlkoenig>"
916                         (first (tm-sparql::object-result
917                                 (first (tm-sparql::select-group q-obj-2)))))))
918        (is (or (string= "<http://some.where/psis/author/goethe>"
919                         (second (tm-sparql::subject-result
920                                  (first (tm-sparql::select-group q-obj-2)))))
921                (string= "<http://some.where/psis/persons/goethe>"
922                         (second (tm-sparql::subject-result
923                                  (first (tm-sparql::select-group q-obj-2)))))))
924        (is (string= "<http://some.where/base-psis/written>"
925                     (second (tm-sparql::predicate-result
926                              (first (tm-sparql::select-group q-obj-2))))))
927        (is (or (string= "<http://some.where/psis/poem/zauberlehrling>"
928                         (second (tm-sparql::object-result
929                                  (first (tm-sparql::select-group q-obj-2)))))
930                (string= "<http://some.where/psis/poem/der_zauberlehrling>"
931                         (second (tm-sparql::object-result
932                                  (first (tm-sparql::select-group q-obj-2)))))
933                (string= "<http://some.where/psis/poem/erlkoenig>"
934                         (second (tm-sparql::object-result
935                                  (first (tm-sparql::select-group q-obj-2)))))))
936        (is-false (first (tm-sparql::subject-result
937                          (first (tm-sparql::select-group q-obj-3)))))
938        (is-false (first (tm-sparql::predicate-result
939                          (first (tm-sparql::select-group q-obj-3)))))
940        (is-false (first (tm-sparql::object-result
941                          (first (tm-sparql::select-group q-obj-3)))))
942        (is-false (first (tm-sparql::subject-result
943                          (second (tm-sparql::select-group q-obj-3)))))
944        (is-false (first (tm-sparql::predicate-result
945                          (second (tm-sparql::select-group q-obj-3)))))
946        (is-false (first (tm-sparql::object-result
947                          (second (tm-sparql::select-group q-obj-3)))))))))
948
949
950(test test-result
951  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
952    (with-revision 0
953      (let* ((query-1 "PREFIX author:<http://some.where/psis/author/>
954                     PREFIX poem:<http://some.where/psis/poem/>
955                     PREFIX basePSIs:<http://some.where/base-psis/>
956                     SELECT ?poems ?poets WHERE {
957                         ?poets a basePSIs:author .
958                         ?poets basePSIs:written ?poems.
959                         ?poems basePSIs:title 'Der Erlkönig' .
960                         ?poems a basePSIs:poem}")
961             (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
962             (query-2 "PREFIX author:<http://some.where/psis/author/>
963                     PREFIX poem:<http://some.where/psis/poem/>
964                     PREFIX basePSIs:<http://some.where/base-psis/>
965                     SELECT * WHERE {
966                         ?poems a basePSIs:poem.
967                         <goethe> <last-name> 'von Goethe' .
968                         ?poems basePSIs:title ?titles}")
969             (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)))
970        (is-true q-obj-1)
971        (is-true q-obj-2)
972        (is (= (length (tm-sparql::select-group q-obj-1)) 4))
973        (is (= (length (tm-sparql::select-group q-obj-2)) 3))
974        (is (= (length (result q-obj-1)) 2))
975        (if (string= (getf (first (result q-obj-1)) :variable) "poets")
976            (progn
977              (is (= (length (getf (first (result q-obj-1)) :result)) 1))
978              (is (or (string= (first (getf (first (result q-obj-1)) :result))
979                               "<http://some.where/psis/author/goethe>")
980                      (string= (first (getf (first (result q-obj-1)) :result))
981                               "<http://some.where/psis/persons/goethe>")))
982              (is (= (length (getf (second (result q-obj-1)) :result)) 1))
983              (is (string= (first (getf (second (result q-obj-1)) :result))
984                           "<http://some.where/psis/poem/erlkoenig>"))
985              (is (string= (getf (second (result q-obj-1)) :variable) "<poems")))
986            (progn
987              (is (= (length (getf (second (result q-obj-1)) :result)) 1))
988              (is (or (string= (first (getf (second (result q-obj-1)) :result))
989                               "<http://some.where/psis/author/goethe>")
990                      (string= (first (getf (second (result q-obj-1)) :result))
991                               "<http://some.where/psis/persons/goethe>")))
992              (is (= (length (getf (first (result q-obj-1)) :result)) 1))
993              (is (string= (first (getf (first (result q-obj-1)) :result))
994                           "<http://some.where/psis/poem/erlkoenig>"))
995              (is (string= (getf (first (result q-obj-1)) :variable) "poems"))))
996        (is (= (length (result q-obj-2)) 2))
997        (if (string= (getf (first (result q-obj-2)) :variable) "titles")
998            (progn
999              (is (= (length (getf (first (result q-obj-2)) :result)) 4))
1000              (is-true
1001               (find "Mondnacht"
1002                     (getf (first (result q-obj-2)) :result) :test #'string=))
1003              (is-true
1004               (find "Der Erlkönig"
1005                     (getf (first (result q-obj-2)) :result) :test #'string=))
1006              (is-true
1007               (find "Der Zauberlehrling"
1008                     (getf (first (result q-obj-2)) :result) :test #'string=))
1009              (is-true
1010               (find "Resignation - Eine Phantasie"
1011                     (getf (first (result q-obj-2)) :result) :test #'string=))
1012              (string= (getf (second (result q-obj-2)) :variable) "poems")
1013              (is-true
1014               (find "<http://some.where/psis/poem/mondnacht>"
1015                     (getf (second (result q-obj-2)) :result) :test #'string=))
1016              (is-true
1017               (find "<http://some.where/psis/poem/resignation>"
1018                     (getf (second (result q-obj-2)) :result) :test #'string=))
1019              (is-true
1020               (find "<http://some.where/psis/poem/erlkoenig>"
1021                     (getf (second (result q-obj-2)) :result) :test #'string=))
1022              (is-true
1023               (or
1024                (find "<http://some.where/psis/poem/zauberlehrling>"
1025                      (getf (second (result q-obj-2)) :result) :test #'string=)
1026                (find "<http://some.where/psis/poem/der_zauberlehrling>"
1027                      (getf (second (result q-obj-2)) :result) :test #'string=))))
1028            (progn
1029              (is (= (length (getf (second (result q-obj-2)) :result)) 4))
1030              (is-true
1031               (find "Mondnacht"
1032                     (getf (second (result q-obj-2)) :result) :test #'string=))
1033              (is-true
1034               (find "Der Erlkönig"
1035                     (getf (second (result q-obj-2)) :result) :test #'string=))
1036              (is-true
1037               (find "Der Zauberlehrling"
1038                     (getf (second (result q-obj-2)) :result) :test #'string=))
1039              (is-true
1040               (find "Resignation - Eine Phantasie"
1041                     (getf (second (result q-obj-2)) :result) :test #'string=))
1042              (string= (getf (first (result q-obj-2)) :variable) "poems")
1043              (is-true
1044               (find "<http://some.where/psis/poem/mondnacht>"
1045                     (getf (first (result q-obj-2)) :result) :test #'string=))
1046              (is-true
1047               (find "<http://some.where/psis/poem/resignation>"
1048                     (getf (first (result q-obj-2)) :result) :test #'string=))
1049              (is-true
1050               (find "<http://some.where/psis/poem/erlkoenig>"
1051                     (getf (first (result q-obj-2)) :result) :test #'string=))
1052              (is-true
1053               (or
1054                (find "<http://some.where/psis/poem/zauberlehrling>"
1055                      (getf (first (result q-obj-2)) :result) :test #'string=)
1056                (find "<http://some.where/psis/poem/der_zauberlehrling>"
1057                      (getf (first (result q-obj-2)) :result) :test #'string=)))))))))
1058
1059
1060(test test-set-boundings
1061  "Tests various cases of the function set-boundings"
1062  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1063         (str-1 "BOUND((  (?var)  )) || (isLITERAL($var) && ?var = 'abc')}")
1064         (result-1 (tm-sparql::set-boundings dummy-object str-1))
1065         (str-2
1066          "(REGEX(?var1, '''''', ?var3) || (?var1 > ?var3 && (STR( ?var) = \"abc\")))}")
1067         (result-2 (tm-sparql::set-boundings dummy-object str-2))
1068         (str-3
1069          "DATATYPE(?var3) || +?var1 = -?var2
1070           ?var1 ?var2 ?var3}")
1071         (result-3 (tm-sparql::set-boundings dummy-object str-3))
1072         (str-4 "DATATYPE(?var3) ||isLITERAL(+?var1 = -?var2)}")
1073         (result-4 (tm-sparql::set-boundings dummy-object str-4))
1074         (str-5 "DATATYPE(?var3) ||(isLITERAL  (+?var1 = -?var2))}")
1075         (result-5 (tm-sparql::set-boundings dummy-object str-5)))
1076    (is-true result-1)
1077    (is-true result-2)
1078    (is (string= (getf result-1 :filter-string)
1079                 "BOUND((progn   (progn ?var)  )) || (progn isLITERAL($var) && ?var = \"abc\")"))
1080    (is (string= (getf result-1 :next-query) "}"))
1081    (is (string= (getf result-2 :filter-string)
1082                 "(progn REGEX(?var1, \"\", ?var3) || (progn ?var1 > ?var3 && (progn STR( ?var) = \"abc\")))"))
1083    (is (string= (getf result-2 :next-query) "}"))
1084    (is (string= (getf result-3 :filter-string)
1085                 "DATATYPE(?var3) || +?var1 = -?var2"))
1086    (is (string= (getf result-3 :next-query) (subseq str-3 34)))
1087    (is (string= (getf result-4 :filter-string)
1088                 "DATATYPE(?var3) ||isLITERAL(+?var1 = -?var2)"))
1089    (is (string= (getf result-4 :next-query) "}"))
1090    (is (string= (getf result-5 :filter-string)
1091                 "DATATYPE(?var3) ||(progn isLITERAL  (+?var1 = -?var2))"))
1092    (is (string= (getf result-5 :next-query) "}"))))
1093
1094
1095(test test-set-unary-operators
1096  "Tests various cases of the function set-unary-operators."
1097  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1098         (str-1 "BOUND(?var1)||(!(+(-(?var1))))}")
1099         (str-2 "!BOUND(?var1) = false}")
1100         (str-3 "+?var1=-$var2}")
1101         (str-4 "!'a\"b\"c' && (+12 = - 14)}")
1102         (str-5 "!'a(+c)' && (+12 = - 14)}")
1103         (str-6 "!'abc)def'}")
1104         (result-1
1105          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1106         (result-1-1 (tm-sparql::set-unary-operators dummy-object result-1))
1107         (result-2
1108          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1109         (result-2-1 (tm-sparql::set-unary-operators dummy-object result-2))
1110         (result-3
1111          (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1112         (result-3-1
1113          (tm-sparql::set-unary-operators dummy-object result-3))
1114         (result-4
1115          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1116         (result-4-1
1117          (tm-sparql::set-unary-operators dummy-object result-4))
1118         (result-5
1119          (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
1120         (result-5-1
1121          (tm-sparql::set-unary-operators dummy-object result-5))
1122         (result-6
1123          (getf (tm-sparql::set-boundings dummy-object str-6) :filter-string))
1124         (result-6-1
1125          (tm-sparql::set-unary-operators dummy-object result-6)))
1126    (is-true result-1)
1127    (is-true result-1-1)
1128    (is-true result-2)
1129    (is-true result-2-1)
1130    (is-true result-3)
1131    (is-true result-3-1)
1132    (is-true result-4)
1133    (is-true result-4-1)
1134    (is-true result-5)
1135    (is-true result-5-1)
1136    (is-true result-6)
1137    (is-true result-6-1)
1138    (is (string=
1139         result-1-1
1140         "BOUND(?var1)||(progn (not (progn (one+ (progn (one- (progn ?var1)))))))"))
1141    (is (string= result-2-1 "(not BOUND(?var1)) = false"))
1142    (is (string= result-3-1 "(one+ ?var1)=(one- $var2)"))
1143    (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (one+ 12) = (one- 14))"))
1144    (is (string= result-5-1 "(not \"a(+c)\") && (progn (one+ 12) = (one- 14))"))
1145    (is (string= result-6-1 "(not \"abc)def\")"))))
1146         
1147
1148(test test-set-or-and-operators
1149  "Tests various cases of the function set-or-and-operators."
1150  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1151         (str-1 "isLITERAL(STR(?var))||?var = 12 && true}")
1152         (str-2 "(true != false || !false ) && 12 < 14 || !isLITERAL(?var)}")
1153         (str-3 "isLITERAL('a(bc||def') && 'abc)def'}")
1154         (str-4 "(a && (b || c))}")
1155         (str-5 "(b || c) && a}")
1156         (result-1
1157          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1158         (result-1-1 (tm-sparql::set-or-and-operators dummy-object result-1 result-1))
1159         (result-2
1160          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1161         (result-2-1 (tm-sparql::set-or-and-operators dummy-object result-2 result-2))
1162         (result-3
1163          (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1164         (result-3-1 (tm-sparql::set-or-and-operators dummy-object result-3 result-3))
1165         (result-4
1166          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1167         (result-4-1 (tm-sparql::set-or-and-operators dummy-object result-4 result-4))
1168         (result-5
1169          (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
1170         (result-5-1 (tm-sparql::set-or-and-operators dummy-object result-5 result-5)))
1171    (is-true result-1)
1172    (is-true result-1-1)
1173    (is-true result-2)
1174    (is-true result-2-1)
1175    (is-true result-3)
1176    (is-true result-3-1)
1177    (is-true result-4)
1178    (is-true result-4-1)
1179    (is-true result-5)
1180    (is-true result-5-1)
1181    (is (string= (string-replace result-1-1 " " "")
1182                 "(and(progn(or(prognisLITERAL(STR(?var)))(progn?var=12)))(progntrue))"))
1183    (is (string= (string-replace result-2-1 " " "")
1184                 "(or(progn(and(progn(progn(or(progntrue!=false)(progn!false))))(progn12<14)))(progn!isLITERAL(?var)))"))
1185    (is (string= (string-replace result-3-1 " " "")
1186                 "(and(prognisLITERAL(\"a(bc||def\"))(progn\"abc)def\"))"))
1187    (is (string= (string-replace result-4-1 " " "")
1188                "(progn(and(progna)(progn(progn(or(prognb)(prognc))))))"))
1189    (is (string= (string-replace result-5-1 " " "")
1190                 "(and(progn(progn(or(prognb)(prognc))))(progna))"))))
1191
1192
1193(test test-set-*-and-/-operators
1194  "Tests various cases of the function set-*-and-/-operators."
1195  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1196         (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}")
1197         (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}")
1198         (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}")
1199         (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}")
1200         (result-1
1201          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1202         (result-1-1
1203          (tm-sparql::set-unary-operators dummy-object result-1))
1204         (result-1-2
1205          (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1))
1206         (result-1-3
1207          (tm-sparql::set-*-and-/-operators dummy-object result-1-2))
1208         (result-2
1209          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1210         (result-2-1
1211          (tm-sparql::set-unary-operators dummy-object result-2))
1212         (result-2-2
1213          (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2))
1214         (result-2-3
1215          (tm-sparql::set-*-and-/-operators dummy-object result-2-2))
1216         (result-3
1217          (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1218         (result-3-1
1219          (tm-sparql::set-unary-operators dummy-object result-3))
1220         (result-3-2
1221          (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3))
1222         (result-3-3
1223          (tm-sparql::set-*-and-/-operators dummy-object result-3-2))
1224         (result-4
1225          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1226         (result-4-1
1227          (tm-sparql::set-unary-operators dummy-object result-4))
1228         (result-4-2
1229          (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4))
1230         (result-4-3
1231          (tm-sparql::set-*-and-/-operators dummy-object result-4-2)))
1232    (is-true result-1) (is-true result-1-1)
1233    (is-true result-1-2) (is-true result-1-3)
1234    (is-true result-2) (is-true result-2-1)
1235    (is-true result-2-2) (is-true result-2-3)
1236    (is-true result-3) (is-true result-3-1)
1237    (is-true result-3-2) (is-true result-3-3)
1238    (is-true result-4) (is-true result-4-1)
1239    (is-true result-4-2) (is-true result-4-3)
1240    (is (string= (string-replace result-1-3 " " "")
1241                 "(or(progn(and(prognx=a+(*bc))(progny=(/a3)+(*b2))))(progn0=12-14+(/(*23)3)))"))
1242    (is (string= (string-replace result-2-3 " " "")
1243                 "(and(prognx=2)(progn(*(progn2+2)2)+(/(*124)2)-10+(*2(progn12-3))+(progn(*123))))"))
1244    (is (string= (string-replace result-3-3 " " "")
1245                 "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(/xy)+(progn(one+1))))))))(progn(one-1))))"))
1246    (is (string= (string-replace result-4-3 " " "")
1247                 "(and(prognisLITERAL((/(progn(*(progn1+\"(13+4*5))\")3))4)))(progn(progn(or(progn12=13+(*1415))(progn(*23)=1)))))"))))
1248
1249
1250(test test-set-+-and---operators
1251  "Tests various cases of the function set-+-and---operators."
1252  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1253         (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}")
1254         (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}")
1255         (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}")
1256         (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}")
1257         (str-5 "(1 + 2 >= 3) || ((2 - 4) + 5 + 6) = 3}")
1258         (result-1
1259          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1260         (result-1-1
1261          (tm-sparql::set-unary-operators dummy-object result-1))
1262         (result-1-2
1263          (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1))
1264         (result-1-3
1265          (tm-sparql::set-*-and-/-operators dummy-object result-1-2))
1266         (result-1-4
1267          (tm-sparql::set-+-and---operators dummy-object result-1-3))
1268         (result-2
1269          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1270         (result-2-1
1271          (tm-sparql::set-unary-operators dummy-object result-2))
1272         (result-2-2
1273          (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2))
1274         (result-2-3
1275          (tm-sparql::set-*-and-/-operators dummy-object result-2-2))
1276         (result-2-4
1277          (tm-sparql::set-+-and---operators dummy-object result-2-3))
1278         (result-3
1279          (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1280         (result-3-1
1281          (tm-sparql::set-unary-operators dummy-object result-3))
1282         (result-3-2
1283          (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3))
1284         (result-3-3
1285          (tm-sparql::set-*-and-/-operators dummy-object result-3-2))
1286         (result-3-4
1287          (tm-sparql::set-+-and---operators dummy-object result-3-3))
1288         (result-4
1289          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1290         (result-4-1
1291          (tm-sparql::set-unary-operators dummy-object result-4))
1292         (result-4-2
1293          (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4))
1294         (result-4-3
1295          (tm-sparql::set-*-and-/-operators dummy-object result-4-2))
1296         (result-4-4
1297          (tm-sparql::set-+-and---operators dummy-object result-4-3))
1298         (result-5
1299          (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
1300         (result-5-1
1301          (tm-sparql::set-unary-operators dummy-object result-5))
1302         (result-5-2
1303          (tm-sparql::set-or-and-operators dummy-object result-5-1 result-5))
1304         (result-5-3
1305          (tm-sparql::set-*-and-/-operators dummy-object result-5-2))
1306         (result-5-4
1307          (tm-sparql::set-+-and---operators dummy-object result-5-3)))
1308    (is-true result-1) (is-true result-1-1)
1309    (is-true result-1-2) (is-true result-1-3)
1310    (is-true result-2) (is-true result-2-1)
1311    (is-true result-2-2) (is-true result-2-3)
1312    (is-true result-3) (is-true result-3-1)
1313    (is-true result-3-2) (is-true result-3-3)
1314    (is-true result-4) (is-true result-4-1)
1315    (is-true result-4-2) (is-true result-4-3)
1316    (is-true result-1-4) (is-true result-2-4)
1317    (is-true result-3-4) (is-true result-4-4)
1318    (is-true result-5) (is-true result-5-1)
1319    (is-true result-5-2) (is-true result-5-3)
1320    (is-true result-5-4)
1321    (is (string= (string-replace result-1-4 " " "")
1322                 "(or(progn(and(prognx=(+a(*bc)))(progny=(+(/a3)(*b2)))))(progn0=(+(-1214)(/(*23)3))))"))
1323    (is (string= (string-replace result-2-4 " " "")
1324                 "(and(prognx=2)(progn(+(+(-(+(*(progn(+22))2)(/(*124)2))10)(*2(progn(-123))))(progn(*123)))))"))
1325    (is (string= (string-replace result-3-4 " " "")
1326                 "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(+(/xy)(progn(one+1)))))))))(progn(one-1))))"))
1327    (is (string= (string-replace result-4-4 " " "")
1328                 "(and(prognisLITERAL((/(progn(*(progn(+1\"(13+4*5))\"))3))4)))(progn(progn(or(progn12=(+13(*1415)))(progn(*23)=1)))))"))
1329    (is (string= (string-replace result-5-4 " " "")
1330                 "(or(progn(progn(+12)>=3))(progn(progn(+(+(progn(-24))5)6))=3))"))))
1331
1332
1333(test test-set-compare-operators
1334  "Tests various cases of the function set-compare-operators."
1335  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1336         (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}")
1337         (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}")
1338         (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}")
1339         (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}")
1340         (str-5 "(1 + 2 >= 3) || ((2 - 4) + 5 + 6) = 3}")
1341         (str-6 "2 > 1 <= 0 != 99 || true}")
1342         (result-1
1343          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1344         (result-1-1
1345          (tm-sparql::set-unary-operators dummy-object result-1))
1346         (result-1-2
1347          (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1))
1348         (result-1-3
1349          (tm-sparql::set-*-and-/-operators dummy-object result-1-2))
1350         (result-1-4
1351          (tm-sparql::set-+-and---operators dummy-object result-1-3))
1352         (result-1-5
1353          (tm-sparql::set-compare-operators dummy-object result-1-4))
1354         (result-2
1355          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1356         (result-2-1
1357          (tm-sparql::set-unary-operators dummy-object result-2))
1358         (result-2-2
1359          (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2))
1360         (result-2-3
1361          (tm-sparql::set-*-and-/-operators dummy-object result-2-2))
1362         (result-2-4
1363          (tm-sparql::set-+-and---operators dummy-object result-2-3))
1364         (result-2-5
1365          (tm-sparql::set-compare-operators dummy-object result-2-4))
1366         (result-3
1367          (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1368         (result-3-1
1369          (tm-sparql::set-unary-operators dummy-object result-3))
1370         (result-3-2
1371          (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3))
1372         (result-3-3
1373          (tm-sparql::set-*-and-/-operators dummy-object result-3-2))
1374         (result-3-4
1375          (tm-sparql::set-+-and---operators dummy-object result-3-3))
1376         (result-3-5
1377          (tm-sparql::set-compare-operators dummy-object result-3-4))
1378         (result-4
1379          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1380         (result-4-1
1381          (tm-sparql::set-unary-operators dummy-object result-4))
1382         (result-4-2
1383          (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4))
1384         (result-4-3
1385          (tm-sparql::set-*-and-/-operators dummy-object result-4-2))
1386         (result-4-4
1387          (tm-sparql::set-+-and---operators dummy-object result-4-3))
1388         (result-4-5
1389          (tm-sparql::set-compare-operators dummy-object result-4-4))
1390         (result-5
1391          (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
1392         (result-5-1
1393          (tm-sparql::set-unary-operators dummy-object result-5))
1394         (result-5-2
1395          (tm-sparql::set-or-and-operators dummy-object result-5-1 result-5))
1396         (result-5-3
1397          (tm-sparql::set-*-and-/-operators dummy-object result-5-2))
1398         (result-5-4
1399          (tm-sparql::set-+-and---operators dummy-object result-5-3))
1400         (result-5-5
1401          (tm-sparql::set-compare-operators dummy-object result-5-4))
1402         (result-6
1403          (getf (tm-sparql::set-boundings dummy-object str-6) :filter-string))
1404         (result-6-1
1405          (tm-sparql::set-unary-operators dummy-object result-6))
1406         (result-6-2
1407          (tm-sparql::set-or-and-operators dummy-object result-6-1 result-6))
1408         (result-6-3
1409          (tm-sparql::set-*-and-/-operators dummy-object result-6-2))
1410         (result-6-4
1411          (tm-sparql::set-+-and---operators dummy-object result-6-3))
1412         (result-6-5
1413          (tm-sparql::set-compare-operators dummy-object result-6-4)))
1414    (is-true result-1) (is-true result-1-1)
1415    (is-true result-1-2) (is-true result-1-3)
1416    (is-true result-2) (is-true result-2-1)
1417    (is-true result-2-2) (is-true result-2-3)
1418    (is-true result-3) (is-true result-3-1)
1419    (is-true result-3-2) (is-true result-3-3)
1420    (is-true result-4) (is-true result-4-1)
1421    (is-true result-4-2) (is-true result-4-3)
1422    (is-true result-1-4) (is-true result-2-4)
1423    (is-true result-3-4) (is-true result-4-4)
1424    (is-true result-5) (is-true result-5-1)
1425    (is-true result-5-2) (is-true result-5-3)
1426    (is-true result-5-4) (is-true result-1-5)
1427    (is-true result-2-5) (is-true result-3-5)
1428    (is-true result-4-5) (is-true result-5-5)
1429    (is-true result-6-1) (is-true result-6-2)
1430    (is-true result-6-3) (is-true result-6-4)
1431    (is-true result-6-5)
1432    (is (string= (string-replace result-1-5 " " "")
1433                 "(or(progn(and(progn(=x(+a(*bc))))(progn(=y(+(/a3)(*b2))))))(progn(=0(+(-1214)(/(*23)3)))))"))
1434    (is (string= (string-replace result-2-5 " " "")
1435                 "(and(progn(=x2))(progn(+(+(-(+(*(progn(+22))2)(/(*124)2))10)(*2(progn(-123))))(progn(*123)))))"))
1436    (is (string= (string-replace result-3-4 " " "")
1437                 "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(+(/xy)(progn(one+1)))))))))(progn(one-1))))"))
1438    (is (string= (string-replace result-4-5 " " "")
1439                 "(and(prognisLITERAL((/(progn(*(progn(+1\"(13+4*5))\"))3))4)))(progn(progn(or(progn(=12(+13(*1415))))(progn(=(*23)1))))))"))
1440    (is (string= (string-replace result-5-5 " " "")
1441                 "(or(progn(progn(>=(+12)3)))(progn(=(progn(+(+(progn(-24))5)6))3)))"))
1442    (is (string= (string-replace result-6-5 " " "")
1443                 "(or(progn(!=(<=(>21)0)99))(progntrue))"))))
1444
1445
1446(test test-set-functions
1447  "Tests various cases of the function set-functions"
1448  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
1449         (str-1 "BOUND((  (?var)  )) || (isLITERAL($var) && ?var = 'abc')}")
1450         (str-2
1451          "(REGEX(?var1, '''''', ?var3) || (?var1 > ?var3 && (STR( ?var) = \"abc\")))}")
1452         (str-3
1453          "STR(DATATYPE(?var3,isLITERAL(x, y))) || +?var1 = -?var2 + ?var2 * ?var3}")
1454         (str-4 "DATATYPE(?var3) ||isLITERAL(+?var1 = -?var2)}")
1455         (str-5 "DATATYPE(?var3) ||(isLITERAL  (+?var1 = -?var2))}")
1456         (result-1
1457          (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
1458         (result-1-2
1459          (tm-sparql::set-or-and-operators dummy-object result-1 result-1))
1460         (result-1-3
1461          (tm-sparql::set-*-and-/-operators dummy-object result-1-2))
1462         (result-1-4
1463          (tm-sparql::set-+-and---operators dummy-object result-1-3))
1464         (result-1-5
1465          (tm-sparql::set-compare-operators dummy-object result-1-4))
1466         (result-1-6
1467          (tm-sparql::set-functions dummy-object result-1-5))
1468         (result-2
1469          (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string))
1470         (result-2-2
1471          (tm-sparql::set-or-and-operators dummy-object result-2 result-2))
1472         (result-2-3
1473          (tm-sparql::set-*-and-/-operators dummy-object result-2-2))
1474         (result-2-4
1475          (tm-sparql::set-+-and---operators dummy-object result-2-3))
1476         (result-2-5
1477          (tm-sparql::set-compare-operators dummy-object result-2-4))
1478         (result-2-6
1479          (tm-sparql::set-functions dummy-object result-2-5))
1480         (result-3
1481              (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string))
1482         (result-3-2-1
1483          (tm-sparql::set-unary-operators dummy-object result-3))
1484         (result-3-2
1485          (tm-sparql::set-or-and-operators dummy-object result-3-2-1 result-3))
1486         (result-3-3
1487          (tm-sparql::set-*-and-/-operators dummy-object result-3-2))
1488         (result-3-4
1489          (tm-sparql::set-+-and---operators dummy-object result-3-3))
1490         (result-3-5
1491          (tm-sparql::set-compare-operators dummy-object result-3-4))
1492         (result-3-6
1493          (tm-sparql::set-functions dummy-object result-3-5))
1494         (result-4
1495          (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string))
1496         (result-4-2-1
1497          (tm-sparql::set-unary-operators dummy-object result-4))
1498         (result-4-2
1499          (tm-sparql::set-or-and-operators dummy-object result-4-2-1 result-4-2-1))
1500         (result-4-3
1501          (tm-sparql::set-*-and-/-operators dummy-object result-4-2))
1502         (result-4-4
1503          (tm-sparql::set-+-and---operators dummy-object result-4-3))
1504         (result-4-5
1505          (tm-sparql::set-compare-operators dummy-object result-4-4))
1506         (result-4-6
1507          (tm-sparql::set-functions dummy-object result-4-5))
1508         (result-5
1509          (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string))
1510         (result-5-2-1
1511          (tm-sparql::set-unary-operators dummy-object result-5))
1512         (result-5-2
1513          (tm-sparql::set-or-and-operators dummy-object result-5-2-1 result-5-2-1))
1514         (result-5-3
1515          (tm-sparql::set-*-and-/-operators dummy-object result-5-2))
1516         (result-5-4
1517          (tm-sparql::set-+-and---operators dummy-object result-5-3))
1518         (result-5-5
1519          (tm-sparql::set-compare-operators dummy-object result-5-4))
1520         (result-5-6
1521          (tm-sparql::set-functions dummy-object result-5-5)))
1522    (is-true result-1) (is-true result-1-2) (is-true result-1-3)
1523    (is-true result-1-4) (is-true result-1-5) (is-true result-1-6)
1524    (is-true result-2) (is-true result-2-2) (is-true result-2-3)
1525    (is-true result-2-4) (is-true result-2-5) (is-true result-2-6)
1526    (is-true result-3) (is-true result-3-2) (is-true result-3-3)
1527    (is-true result-3-4) (is-true result-3-5) (is-true result-3-6)
1528    (is-true result-4) (is-true result-4-2) (is-true result-4-3)
1529    (is-true result-4-4) (is-true result-4-5) (is-true result-4-6)
1530    (is-true result-5) (is-true result-5-2) (is-true result-5-3)
1531    (is-true result-5-4) (is-true result-5-5) (is-true result-5-6)
1532    (is (string= (string-replace result-1-6 " " "")
1533                 "(or(progn(BOUND(progn(progn\"?var\"))))(progn(progn(and(progn(isLITERAL$var))(progn(=?var\"abc\"))))))"))
1534    (is (string= (string-replace result-2-6 " " "")
1535                 "(progn(or(progn(REGEX?var1\"\"?var3))(progn(progn(and(progn(>?var1?var3))(progn(progn(=(STR?var)\"abc\"))))))))"))
1536    (is (string= (string-replace result-3-6 " " "")
1537                 "(or(progn(STR(DATATYPE?var3(isLITERALxy))))(progn(=(one+?var1)(+(one-?var2)(*?var2?var3)))))"))
1538    (is (string= (string-replace result-4-6 " " "")
1539                 "(or(progn(DATATYPE?var3))(progn(isLITERAL(=(one+?var1)(one-?var2)))))"))
1540    (is (string= (string-replace result-5-6 " " "")
1541                 "(or(progn(DATATYPE?var3))(progn(progn(isLITERAL(=(one+?var1)(one-?var2))))))"))))
1542
1543
1544(test test-module-1
1545  "Tests the entire module."
1546  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
1547    (with-revision 0
1548      (let* ((query-1
1549              "BASE <http://some.where/psis/poem/>
1550               SELECT $subject ?predicate WHERE{
1551                ?subject $predicate <zauberlehrling> .
1552                FILTER (STR(?predicate) = '\"<http://some.where/base-psis/written>\"')}")
1553             (query-2 "SELECT ?object ?subject WHERE{
1554                        <http://some.where/psis/author/goethe> ?predicate ?object .
1555                        FILTER (isLITERAL(?object) &&
1556                                DATATYPE(?object) =
1557                                 'http://www.w3.org/2001/XMLSchema#string')}")
1558             (query-3 "SELECT ?object ?subject WHERE{
1559                        <http://some.where/psis/author/goethe> ?predicate ?object .
1560                        FILTER (notAllowed(?subject)}")
1561             (query-4 "SELECT ?object ?predicate WHERE{
1562                        <http://some.where/psis/author/goethe> ?predicate ?object .
1563                        FILTER ((notAllowed( ?predicate)))}")
1564             (query-5 "SELECT ?object ?subject WHERE{
1565                        <http://some.where/psis/author/goethe> ?predicate ?object .
1566                        FILTER(?a && (?b || ?c)}")
1567             (result-1
1568              (tm-sparql:result
1569               (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)))
1570             (result-2 
1571              (tm-sparql:result
1572               (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))))
1573        (is-true result-1)
1574        (is-true result-2)
1575        (signals exceptions:sparql-parser-error
1576          (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
1577        (signals exceptions:sparql-parser-error
1578          (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query query-4)))
1579        (signals exceptions:sparql-parser-error
1580          (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query query-5)))
1581        (is (= (length result-1) 2))
1582        (if (string= (getf (first result-1) :variable) "subject")
1583            (progn
1584              (is (= (length (getf (first result-1) :result)) 1))
1585              (is (string= (first (getf (first result-1) :result))
1586                           "<http://some.where/psis/author/goethe>"))
1587              (is (string= (getf (second result-1) :variable) "predicate"))
1588              (is (= (length (getf (second result-1) :result)) 1))
1589              (is (string= (first (getf (second result-1) :result))
1590                           "<http://some.where/base-psis/written>")))
1591            (progn
1592              (is (= (length (getf (second result-1) :result)) 1))
1593              (is (string= (first (getf (second result-1) :result))
1594                           "<http://some.where/psis/author/goethe>"))
1595              (is (string= (getf (first result-1) :variable) "predicate"))
1596              (is (= (length (getf (first result-1) :result)) 1))
1597              (is (string= (first (getf (first result-1) :result))
1598                           "<http://some.where/base-psis/written>"))))
1599        (if (string= (getf (first result-2) :variable) "subject")
1600            (progn 
1601              (is (= (length (getf (first result-2) :result)) 0))
1602              (is (string= (getf (second result-2) :variable) "object"))
1603              (is (= (length (getf (second result-2) :result)) 3))
1604              (is-false (set-exclusive-or
1605                         (getf (second result-2) :result)
1606                         (list "Johann Wolfgang" "von Goethe"
1607                               (concat "\"\"\"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe\"\"\"^^" *xml-uri*))
1608                         :test #'string=)))
1609            (progn 
1610              (is (= (length (getf (second result-2) :result)) 0))
1611              (is (string= (getf (first result-2) :variable) "object"))
1612              (is (= (length (getf (first result-2) :result)) 3))
1613              (is-false (set-exclusive-or
1614                         (getf (first result-2) :result)
1615                         (list "Johann Wolfgang" "von Goethe"
1616                               (concat "\"\"\"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe\"\"\"^^" *xml-uri*))
1617                         :test #'string=))))))))
1618
1619
1620(test test-module-2
1621  "Tests the entire module."
1622  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
1623    (with-revision 0
1624      (let* ((query-1
1625              "PREFIX poem:<http://some.where/psis/poem/>
1626               PREFIX author:<http://some.where/psis/author/>
1627               PREFIX main:<http://some.where/base-psis/>
1628               PREFIX tmdm:<http://psi.topicmaps.org/iso13250/model/>
1629               SELECT ?poems WHERE{
1630                ?poems tmdm:type main:poem . #self as ?x a <y>
1631                ?poems main:title ?titles .
1632                FILTER (REGEX(?titles, '[a-zA-Z]+ [a-zA-Z]+')) }")
1633             (result-1
1634              (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))))
1635        (is-true result-1)
1636        (is (= (length result-1) 1))
1637        (is (string= (getf (first result-1) :variable) "poems"))
1638        (is-false (set-exclusive-or
1639                   (getf (first result-1) :result)
1640                   (list "<http://some.where/psis/poem/resignation>"
1641                         "<http://some.where/psis/poem/erlkoenig>"
1642                         "<http://some.where/psis/poem/zauberlehrling>")
1643                   :test #'string=))))))
1644
1645
1646(test test-module-3
1647  "Tests the entire module with the file sparql_test.xtm"
1648  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1649    (tm-sparql:init-tm-sparql)
1650    (let* ((q-1 (concat
1651                 "SELECT * WHERE {
1652                  ?subj1 <http://some.where/tmsparql/first-name> \"Johann Wolfgang\".
1653                  ?subj2 <http://some.where/tmsparql/last-name> 'von Goethe'^^"
1654                                           *xml-string* ".
1655                  ?subj3 <http://some.where/tmsparql/date-of-birth> '28.08.1749'^^"
1656                                           *xml-date* ".
1657                  ?subj4 <http://some.where/tmsparql/date-of-death> '22.03.1832'^^"
1658                                           *xml-date* ".
1659                  ?subj5 <http://some.where/tmsparql/years> 82.0.
1660                  ?subj6 <http://some.where/tmsparql/years> 82.
1661                  ?subj7 <http://some.where/tmsparql/years> '82'^^" *xml-integer* ".
1662                  ?subj8 <http://some.where/tmsparql/isDead> true.
1663                  ?subj9 <http://some.where/tmsparql/isDead> 'true'^^" *xml-boolean* ".
1664                  ?subj10 <http://some.where/tmsparql/isDead> 'false'^^" *xml-boolean* ".
1665                  ?subj11 <http://some.where/tmsparql/isDead> false"
1666                 "}"))
1667           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1668      (is-true (= (length r-1) 11))
1669      (map 'list #'(lambda(item)
1670                     (cond ((or (string= (getf item :variable) "subj1")
1671                                (string= (getf item :variable) "subj2")
1672                                (string= (getf item :variable) "subj3")
1673                                (string= (getf item :variable) "subj4")
1674                                (string= (getf item :variable) "subj6")
1675                                (string= (getf item :variable) "subj7")
1676                                (string= (getf item :variable) "subj8")
1677                                (string= (getf item :variable) "subj9"))
1678                            (is (string= (first (getf item :result))
1679                                         "<http://some.where/tmsparql/author/goethe>")))
1680                           ((or (string= (getf item :variable) "subj5")
1681                                (string= (getf item :variable) "subj10")
1682                                (string= (getf item :variable) "subj11"))
1683                            (is-false (getf item :result)))
1684                           (t
1685                            (is-true (format t "bad variable-name found")))))
1686           r-1))
1687    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/topicProperty"
1688                                :revision 0))
1689    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/reifier"
1690                                :revision 0))
1691    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/role"
1692                                :revision 0))
1693    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/player"
1694                                :revision 0))
1695    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/scope"
1696                                :revision 0))
1697    (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/value"
1698                                :revision 0))
1699    (is-true (d:get-item-by-psi *rdf-type* :revision 0))))
1700
1701
1702(test test-module-4
1703  "Tests the entire module with the file sparql_test.xtm"
1704  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1705    (tm-sparql:init-tm-sparql)
1706    (let* ((q-1 (concat
1707                 "PREFIX pref:<http://www.w3.org/1999/02/>
1708                  SELECT * WHERE {
1709                  ?subj1 a <http://some.where/tmsparql/author> .
1710                  ?subj2 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> <http://some.where/tmsparql/author> .
1711                  ?subj3 <http://psi.topicmaps.org/iso13250/model/type> <http://some.where/tmsparql/author> .
1712                  ?subj4 pref:22-rdf-syntax-ns#type <http://some.where/tmsparql/author>"
1713                 "}"))
1714           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1715      (is-true (= (length r-1) 4))
1716      (map 'list #'(lambda(item)
1717                     (cond ((or (string= (getf item :variable) "subj1")
1718                                (string= (getf item :variable) "subj2")
1719                                (string= (getf item :variable) "subj3")
1720                                (string= (getf item :variable) "subj4"))
1721                            (is (string= (first (getf item :result))
1722                                         "<http://some.where/tmsparql/author/goethe>")))
1723                           (t
1724                            (is-true (format t "bad variable-name found")))))
1725           r-1))))
1726
1727
1728(test test-module-5
1729  "Tests the entire module with the file sparql_test.xtm"
1730  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1731    (tm-sparql:init-tm-sparql)
1732    (let* ((q-1 (concat
1733                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1734                  SELECT * WHERE {
1735                   <http://some.where/ii/goethe-occ> tms:reifier ?obj1.
1736                   ?subj1 tms:reifier <http://some.where/ii/goethe-name-reifier>"
1737                 "}"))
1738           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1739      (is-true (= (length r-1) 2))
1740      (map 'list #'(lambda(item)
1741                     (cond ((string= (getf item :variable) "subj1")
1742                            (is (string=
1743                                 (first (getf item :result))
1744                                 (concat "_:n"
1745                                         (write-to-string
1746                                          (elephant::oid
1747                                           (d:get-item-by-content "von Goethe")))))))
1748                           ((string= (getf item :variable) "obj1")
1749                            (is (string= (first (getf item :result))
1750                                         "<http://some.where/ii/goethe-occ-reifier>")))
1751                           (t
1752                            (is-true (format t "bad variable-name found")))))
1753           r-1))))
1754
1755
1756(test test-module-6
1757  "Tests the entire module with the file sparql_test.xtm"
1758  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1759    (tm-sparql:init-tm-sparql)
1760    (let* ((q-1 (concat
1761                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1762                  SELECT * WHERE {
1763                   ?assoc tms:reifier <http://some.where/ii/association-reifier>.
1764                   <http://some.where/ii/association> tms:role ?roles.
1765                   ?assoc2 tms:role <http://some.where/ii/role-2>"
1766                 "}"))
1767           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
1768           (role-1 (concat "_:r" (write-to-string
1769                                  (elephant::oid
1770                                   (first (roles
1771                                           (get-item-by-item-identifier 
1772                                            "http://some.where/ii/association"
1773                                            :revision 0)))))))
1774           (role-2 (concat "_:r" (write-to-string
1775                                  (elephant::oid
1776                                   (second (roles
1777                                            (get-item-by-item-identifier 
1778                                             "http://some.where/ii/association"
1779                                             :revision 0))))))))
1780      (is-true (= (length r-1) 3))
1781      (map 'list #'(lambda(item)
1782                     (cond ((string= (getf item :variable) "assoc")
1783                            (is (string= (first (getf item :result))
1784                                         "<http://some.where/ii/association>")))
1785                            ((string= (getf item :variable) "roles")
1786                            (is (or (string= (first (getf item :result))
1787                                             role-1)
1788                                    (string= (first (getf item :result))
1789                                             role-2)
1790                                    (string= (first (getf item :result))
1791                                             "<http://some.where/ii/role-2>")))
1792                             (is (or (string= (second (getf item :result))
1793                                              role-1)
1794                                     (string= (second (getf item :result))
1795                                              role-2)
1796                                     (string= (second (getf item :result))
1797                                              "<http://some.where/ii/role-2>"))))
1798                            ((string= (getf item :variable) "assoc2")
1799                             (is (string= (first (getf item :result))
1800                                          "<http://some.where/ii/association>")))
1801                            (t
1802                             (is-true (format t "bad variable-name found")))))
1803           r-1))))
1804
1805
1806(test test-module-7
1807  "Tests the entire module with the file sparql_test.xtm"
1808  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1809    (tm-sparql:init-tm-sparql)
1810    (let* ((q-1 (concat
1811                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1812                  SELECT * WHERE {
1813                   <http://some.where/ii/role-2> tms:player ?player.
1814                   ?role tms:player <http://some.where/psis/poem/zauberlehrling>"
1815                 "}"))
1816           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1817      (is-true (= (length r-1) 2))
1818      (map 'list #'(lambda(item)
1819                     (cond ((string= (getf item :variable) "player")
1820                            (is (string=
1821                                 (first (getf item :result))
1822                                 "<http://some.where/psis/poem/zauberlehrling>")))
1823                           ((string= (getf item :variable) "role")
1824                            (is (= (length (getf item :result)) 2))
1825                            ;one role is the type-instance role
1826                            (is (or (string= (first (getf item :result))
1827                                             "<http://some.where/ii/role-2>")
1828                                    (string= (second (getf item :result))
1829                                             "<http://some.where/ii/role-2>"))))
1830                           (t
1831                            (is-true (format t "bad variable-name found")))))
1832           r-1))))
1833
1834
1835(test test-module-8
1836  "Tests the entire module with the file sparql_test.xtm"
1837  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1838    (tm-sparql:init-tm-sparql)
1839    (let* ((q-1 (concat
1840                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1841                  SELECT * WHERE {
1842                   <http://some.where/tmsparql/author/goethe> tms:topicProperty ?props.
1843                   ?subj1 tms:topicProperty <http://some.where/ii/goethe-untyped-name>.
1844                   ?subj2 tms:topicProperty <http://some.where/ii/goethe-occ>"
1845                 "}"))
1846           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
1847           (prop-ids
1848            (map 'list
1849                 #'(lambda(prop)
1850                     (if (item-identifiers prop :revision 0)
1851                         (concat "<" (d:uri (first (item-identifiers
1852                                                    prop :revision 0))) ">")
1853                         (if (typep prop 'OccurrenceC)
1854                             (concat "_:o" (write-to-string (elephant::oid prop)))
1855                             (concat "_:n" (write-to-string (elephant::oid prop))))))
1856                 (append (names (get-item-by-psi
1857                                 "http://some.where/tmsparql/author/goethe"
1858                                 :revision 0))
1859                         (occurrences (get-item-by-psi
1860                                       "http://some.where/tmsparql/author/goethe"
1861                                       :revision 0))))))
1862      (is-true (= (length r-1) 3))
1863      (map 'list #'(lambda(item)
1864                     (cond ((or (string= (getf item :variable) "subj1")
1865                                (string= (getf item :variable) "subj2"))
1866                            (is (string=
1867                                 (first (getf item :result))
1868                                 "<http://some.where/tmsparql/author/goethe>")))
1869                           ((string= (getf item :variable) "props")
1870                            (is (= (length (getf item :result)) 8))
1871                            (is-false (set-exclusive-or prop-ids (getf item :result)
1872                                                        :test #'string=)))
1873                           (t
1874                            (is-true (format t "bad variable-name found")))))
1875           r-1))))
1876
1877
1878(test test-module-9
1879  "Tests the entire module with the file sparql_test.xtm"
1880  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1881    (tm-sparql:init-tm-sparql)
1882    (let* ((q-1 (concat
1883                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1884                  SELECT * WHERE {
1885                   <http://some.where/ii/zb/occurrence> tms:scope ?scope.
1886                   ?owner tms:scope <http://some.where/tmsparql/de>"
1887                 "}"))
1888           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1889      (is-true (= (length r-1) 2))
1890      (map 'list #'(lambda(item)
1891                     (cond ((string= (getf item :variable) "scope")
1892                            (is (string= (first (getf item :result))
1893                                         "<http://some.where/tmsparql/de>")))
1894                           ((string= (getf item :variable) "owner")
1895                            (is (string= (first (getf item :result))
1896                                         "<http://some.where/ii/zb/occurrence>")))
1897                           (t
1898                            (is-true (format t "bad variable-name found")))))
1899           r-1))))
1900
1901
1902(test test-module-10
1903  "Tests the entire module with the file sparql_test.xtm"
1904  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1905    (tm-sparql:init-tm-sparql)
1906    (let* ((q-1 (concat
1907                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1908                  SELECT * WHERE {
1909                   <http://some.where/ii/goethe-untyped-name> tms:value ?obj1.
1910                   <http://some.where/ii/goethe-occ> tms:value ?obj2.
1911                   <http://some.where/ii/goethe-variant> tms:value ?obj3.
1912                   ?subj1 tms:value 'Goethe'.
1913                   ?subj2 tms:value '28.08.1749'^^http://www.w3.org/2001/XMLSchema#date.
1914                   ?subj3 tms:value 'Johann Wolfgang von Goethe'.
1915                   ?subj4 tms:value 82"
1916                 "}"))
1917           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1918      (is-true (= (length r-1) 7))
1919      (map 'list #'(lambda(item)
1920                     (cond ((string= (getf item :variable) "obj1")
1921                            (is (string= (first (getf item :result))
1922                                         "Johann Wolfgang von Goethe")))
1923                           ((string= (getf item :variable) "obj2")
1924                            (is (string= (first (getf item :result))
1925                                         (concat "\"\"\"28.08.1749\"\"\"^^"
1926                                                 *xml-date*))))
1927                           ((string= (getf item :variable) "obj3")
1928                            (is (string= (first (getf item :result))
1929                                         "Goethe")))
1930                           ((string= (getf item :variable) "subj1")
1931                            (is (string= (first (getf item :result))
1932                                         "<http://some.where/ii/goethe-variant>")))
1933                           ((string= (getf item :variable) "subj2")
1934                            (is (string= (first (getf item :result))
1935                                         "<http://some.where/ii/goethe-occ>")))
1936                           ((string= (getf item :variable) "subj3")
1937                            (is (string= (first (getf item :result))
1938                                         "<http://some.where/ii/goethe-untyped-name>")))
1939                           ((string= (getf item :variable) "subj4")
1940                            (is (string= (first (getf item :result))
1941                                         "<http://some.where/ii/goethe-years-occ>")))
1942                           (t
1943                            (is-true (format t "bad variable-name found")))))
1944           r-1))))
1945
1946
1947(test test-module-11
1948  "Tests the entire module with the file sparql_test.xtm"
1949  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1950    (tm-sparql:init-tm-sparql)
1951    (let* ((q-1 (concat
1952                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1953                  SELECT * WHERE {
1954                   <http://some.where/tmsparql/author/goethe> a <http://some.where/tmsparql/author>.
1955                   <http://some.where/ii/goethe-occ> tms:reifier <http://some.where/ii/goethe-occ-reifier>.
1956                   <http://some.where/ii/association> tms:role <http://some.where/ii/role-2>.
1957                   <http://some.where/ii/role-2> tms:player <http://some.where/psis/poem/zauberlehrling>.
1958                   <http://some.where/tmsparql/author/goethe> tms:topicProperty <http://some.where/ii/goethe-untyped-name>.
1959                   <http://some.where/ii/goethe-variant> tms:scope <http://some.where/tmsparql/display-name>.
1960                   <http://some.where/ii/goethe-untyped-name> tms:value 'Johann Wolfgang von Goethe'"
1961                 "}"))
1962           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1963      (is-false r-1))))
1964
1965
1966(test test-module-12
1967  "Tests the entire module with the file sparql_test.xtm"
1968  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
1969    (tm-sparql:init-tm-sparql)
1970    (let* ((q-1 (concat
1971                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
1972                  SELECT * WHERE {
1973                   ?subj1 a ?obj1.
1974                   ?subj2 tms:reifier ?obj2.
1975                   ?subj3 tms:role ?obj3.
1976                   ?subj4 tms:player ?obj4.
1977                   ?subj5 tms:topicProperty ?obj5.
1978                   ?subj6 tms:scope ?obj6.
1979                   ?subj7 tms:value ?obj7"
1980                 "}"))
1981           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
1982      (is (= (length r-1) 14))
1983      (map 'list #'(lambda(item)
1984                     (cond ((string= (getf item :variable) "subj1")
1985                            (is (= (length (getf item :result)) 29)))
1986                           ((string= (getf item :variable) "obj2")
1987                            (is (= (length (getf item :result)) 4))
1988                            (is-false (set-exclusive-or
1989                                       (getf item :result)
1990                                       (list "<http://some.where/ii/goethe-name-reifier>"
1991                                             "<http://some.where/ii/goethe-occ-reifier>"
1992                                             "<http://some.where/ii/association-reifier>"
1993                                             "<http://some.where/ii/role-reifier>")
1994                                       :test #'string=)))
1995                           ((string= (getf item :variable) "subj3")
1996                            (is (= (length (getf item :result)) 60))
1997                            (is (find "<http://some.where/ii/association>"
1998                                      (getf item :result) :test #'string=)))
1999                           ((string= (getf item :variable) "subj4")
2000                            (is (= (length (getf item :result)) 60)))
2001                           ((string= (getf item :variable) "subj5")
2002                            (is (= (length (getf item :result)) 10)))
2003                           ((string= (getf item :variable) "subj6")
2004                            (is (= (length (getf item :result)) 2))
2005                            (set-exclusive-or
2006                             (getf item :result)
2007                             (list "<http://some.where/ii/zb/occurrence>"
2008                                   "<http://some.where/ii/goethe-variant>")
2009                             :test #'string=))
2010                           ((string= (getf item :variable) "subj7")
2011                            (is (= (length (getf item :result)) 11)))
2012                           ((string= (getf item :variable) "obj1")
2013                            (is (= (length (getf item :result)) 29)))
2014                           ((string= (getf item :variable) "subj2")
2015                            (is (= (length (getf item :result)) 4))
2016                            (is-false
2017                             (set-exclusive-or
2018                              (getf item :result)
2019                              (list
2020                               "<http://some.where/ii/goethe-occ>"
2021                               "<http://some.where/ii/association>"
2022                               (concat
2023                                "_:r"
2024                                (write-to-string
2025                                 (elephant::oid
2026                                  (loop for role in
2027                                       (roles (get-item-by-item-identifier
2028                                               "http://some.where/ii/association"
2029                                               :revision 0) :revision 0)
2030                                     when (string=
2031                                           (uri (first
2032                                                 (psis (player role :revision 0)
2033                                                       :revision 0)))
2034                                           "http://some.where/tmsparql/author/goethe")
2035                                     return role))))
2036                               (concat
2037                                "_:n"
2038                                (write-to-string
2039                                 (elephant::oid
2040                                  (loop for name in
2041                                       (names
2042                                        (get-item-by-psi
2043                                         "http://some.where/tmsparql/author/goethe"
2044                                         :revision 0) :revision 0)
2045                                     when (string= (charvalue name) "von Goethe")
2046                                     return name)))))
2047                              :test #'string=)))
2048                           ((string= (getf item :variable) "obj3")
2049                            (is (= (length (getf item :result)) 60))
2050                            (is (find "<http://some.where/ii/role-2>"
2051                                      (getf item :result) :test #'string=)))
2052                           ((string= (getf item :variable) "obj4")
2053                            (is (= (length (getf item :result)) 60)))
2054                           ((string= (getf item :variable) "obj5")
2055                            (is (= (length (getf item :result)) 10)))
2056                           ((string= (getf item :variable) "obj6")
2057                            (is (= (length (getf item :result)) 2))
2058                            (set-exclusive-or
2059                             (getf item :result)
2060                             (list "<http://some.where/tmsparql/display-name>"
2061                                   "<http://some.where/tmsparql/de>")))
2062                           ((string= (getf item :variable) "obj7")
2063                            (is (= (length (getf item :result)) 11))
2064                            (set-exclusive-or
2065                             (getf item :result)
2066                             (list "Johann Wolfgang" "von Goethe"
2067                                   "Johann Wolfgang von Goethe" "Der Zauberlehrling"
2068                                   "28.08.1749" "22.03.1832" 82 t nil
2069                                   "Hat der alte Hexenmeister
2070        sich doch einmal wegbegeben!
2071        ...
2072      ")
2073                             :test #'tm-sparql::literal=))
2074                            (t
2075                             (is-true (format t "bad variable-name found")))))
2076           r-1))))
2077
2078
2079(test test-module-13
2080  "Tests the entire module with the file sparql_test.xtm"
2081  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
2082    (tm-sparql:init-tm-sparql)
2083    (let* ((q-1 (concat
2084                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
2085                  SELECT * WHERE {
2086                   <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
2087                   <http://some.where/ii/association> ?pred2 ?obj2.
2088                   <http://some.where/ii/role-2> ?pred3 ?obj3.
2089                   <http://some.where/ii/goethe-untyped-name> ?pred4 ?obj4.
2090                   <http://some.where/ii/goethe-occ> ?pred5 ?obj5.
2091                   <http://some.where/ii/goethe-variant> ?pred6 ?obj6"
2092                 "}"))
2093           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
2094      (is-true (= (length r-1) 12))
2095      (map 'list #'(lambda(item)
2096                     (cond ((string= (getf item :variable) "pred1")
2097                            (is (= (length (getf item :result)) 18)))
2098                           ((string= (getf item :variable) "pred2")
2099                            (is (= (length (getf item :result)) 3))
2100                            (is-false (set-exclusive-or
2101                                       (getf item :result)
2102                                       (list (concat "<" *tms-role* ">")
2103                                             (concat "<" *tms-reifier* ">"))
2104                                       :test #'string=)))
2105                           ((string= (getf item :variable) "pred3")
2106                            (is (= (length (getf item :result)) 1))
2107                            (is (string= (first (getf item :result))
2108                                         (concat "<" *tms-player* ">"))))
2109                           ((string= (getf item :variable) "pred4")
2110                            (is (= (length (getf item :result)) 1))
2111                            (is (string= (first (getf item :result))
2112                                         (concat "<" *tms-value* ">"))))
2113                           ((string= (getf item :variable) "pred5")
2114                            (is (= (length (getf item :result)) 2))
2115                            (is-false (set-exclusive-or
2116                                       (getf item :result)
2117                                       (list (concat "<" *tms-value* ">")
2118                                             (concat "<" *tms-reifier* ">"))
2119                                       :test #'string=)))
2120                           ((string= (getf item :variable) "pred6")
2121                            (is (= (length (getf item :result)) 2))
2122                            (is-false (set-exclusive-or
2123                                       (getf item :result)
2124                                       (list (concat "<" *tms-value* ">")
2125                                             (concat "<" *tms-scope* ">"))
2126                                       :test #'string=)))
2127                           ((string= (getf item :variable) "obj1")
2128                            (is (= (length (getf item :result)) 18))
2129                            (is-true (find "Johann Wolfgang" (getf item :result)
2130                                           :test #'tm-sparql::literal=))
2131                            (is-true (find "Johann Wolfgang von Goethe"
2132                                           (getf item :result)
2133                                           :test #'tm-sparql::literal=))
2134                            (is-true (find "von Goethe" (getf item :result)
2135                                           :test #'tm-sparql::literal=))
2136                            (is-true (find t (getf item :result)
2137                                           :test #'tm-sparql::literal=))
2138                            (is-true (position nil (getf item :result)
2139                                               :test #'tm-sparql::literal=))
2140                            (is-true (find (concat "'28.08.1749'^^" *xml-date*)
2141                                           (getf item :result)
2142                                           :test #'tm-sparql::literal=))
2143                            (is-true (find (concat "'22.03.1832'^^" *xml-date*)
2144                                           (getf item :result)
2145                                           :test #'tm-sparql::literal=))
2146                            (is-true (find 82 (getf item :result)
2147                                           :test #'tm-sparql::literal=))
2148                            (is-true (find "<http://some.where/tmsparql/author>"
2149                                           (getf item :result)
2150                                           :test #'tm-sparql::literal=))
2151                            (is-true
2152                             (find "<http://some.where/psis/poem/zauberlehrling>"
2153                                   (getf item :result) :test #'tm-sparql::literal=)))
2154                           ((string= (getf item :variable) "obj2")
2155                            (is (= (length (getf item :result)) 3))
2156                            (is-false
2157                             (set-exclusive-or
2158                              (getf item :result)
2159                              (list
2160                               "<http://some.where/ii/association-reifier>"
2161                               "<http://some.where/ii/role-2>"
2162                               (concat
2163                                "_:r"
2164                                (write-to-string
2165                                 (elephant::oid
2166                                  (loop for role in
2167                                       (roles
2168                                        (get-item-by-item-identifier
2169                                         "http://some.where/ii/association"
2170                                         :revision 0))
2171                                     when (string=
2172                                           (uri (first (psis (player role
2173                                                                     :revision 0))))
2174                                           "http://some.where/tmsparql/author/goethe")
2175                                     return role)))))
2176                              :test #'string=)))
2177                           ((string= (getf item :variable) "obj3")
2178                            (is (= (length (getf item :result)) 1))
2179                            (is (string=
2180                                 (first (getf item :result))
2181                                 "<http://some.where/psis/poem/zauberlehrling>")))
2182                           ((string= (getf item :variable) "obj4")
2183                            (is (= (length (getf item :result)) 1))
2184                            (is (string= (first (getf item :result))
2185                                         "Johann Wolfgang von Goethe")))
2186                           ((string= (getf item :variable) "obj5")
2187                            (is (= (length (getf item :result)) 2))
2188                            (is-false
2189                             (set-exclusive-or
2190                              (getf item :result)
2191                              (list (concat "'28.08.1749'^^" *xml-date*)
2192                                    "<http://some.where/ii/goethe-occ-reifier>")
2193                              :test #'tm-sparql::literal=)))
2194                           ((string= (getf item :variable) "obj6")
2195                           (is (= (length (getf item :result)) 2))
2196                            (is-false
2197                             (set-exclusive-or
2198                              (getf item :result)
2199                              (list "Goethe"
2200                                    "<http://some.where/tmsparql/display-name>")
2201                              :test #'string=)))
2202                           (t
2203                            (is-true (format t "bad variable-name found")))))
2204           r-1))))
2205
2206
2207(test test-module-14
2208  "Tests the entire module with the file sparql_test.xtm"
2209  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
2210    (tm-sparql:init-tm-sparql)
2211    (let* ((q-1 (concat
2212                 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
2213                  SELECT * WHERE {
2214                   ?subj1 ?pred1 <http://some.where/tmsparql/author/goethe>.
2215                   ?subj2 ?pred2 <http://some.where/ii/goethe-variant>.
2216                   ?subj3 ?pred3 <http://some.where/ii/goethe-untyped-name>.
2217                   ?subj4 ?pred4 <http://some.where/ii/goethe-occ>.
2218                   ?subj5 ?pred5 <http://some.where/ii/association>.
2219                   ?subj6 ?pred6 <http://some.where/ii/role-2>.
2220                   ?subj7 ?pred7 <http://some.where/tmsparql/display-name>.
2221                   ?subj8 ?pred8 <http://some.where/ii/role-reifier>"
2222                 "}"))
2223           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
2224      (is-true (= (length r-1) 16))
2225      (map 'list #'(lambda(item)
2226                     (cond ((string= (getf item :variable) "pred1")
2227                            (is (= (length (getf item :result)) 4))
2228                            (is-false
2229                             (set-exclusive-or
2230                              (list (concat "<" *instance-psi* ">")
2231                                    "<http://some.where/tmsparql/writer>"
2232                                    (concat "<" *tms-player* ">"))
2233                              (getf item :result) :test #'string=)))
2234                           ((string= (getf item :variable) "subj1")
2235                            (is (= (length (getf item :result)) 4))
2236                            (is-false
2237                             (set-exclusive-or
2238                              (list "<http://some.where/tmsparql/author>"
2239                                    "<http://some.where/psis/poem/zauberlehrling>"
2240                                    (concat
2241                                     "_:r"
2242                                     (write-to-string
2243                                      (elephant::oid
2244                                       (first
2245                                        (player-in-roles
2246                                         (get-item-by-psi
2247                                          "http://some.where/tmsparql/author/goethe"
2248                                          :revision 0) :revision 0)))))
2249                                    (concat
2250                                     "_:r"
2251                                     (write-to-string
2252                                      (elephant::oid
2253                                       (second
2254                                        (player-in-roles
2255                                         (get-item-by-psi
2256                                          "http://some.where/tmsparql/author/goethe"
2257                                          :revision 0) :revision 0))))))
2258                              (getf item :result) :test #'string=)))
2259                            ((or (string= (getf item :variable) "pred2")
2260                                 (string= (getf item :variable) "pred5"))
2261                             (is-false (getf item :result)))
2262                            ((or (string= (getf item :variable) "subj2")
2263                                 (string= (getf item :variable) "subj5"))
2264                             (is-false (getf item :result)))
2265                            ((or (string= (getf item :variable) "pred3")
2266                                 (string= (getf item :variable) "pred4"))
2267                             (is (= (length (getf item :result)) 1))
2268                             (is (string= (first (getf item :result))
2269                                          (concat "<" *tms-topicProperty* ">"))))
2270                            ((or (string= (getf item :variable) "subj3")
2271                                 (string= (getf item :variable) "subj4"))
2272                             (is (= (length (getf item :result)) 1))
2273                             (is (string= (first (getf item :result))
2274                                          "<http://some.where/tmsparql/author/goethe>")))
2275                            ((string= (getf item :variable) "pred6")
2276                             (is (= (length (getf item :result)) 1))
2277                             (is (string= (first (getf item :result))
2278                                          (concat "<" *tms-role* ">"))))
2279                            ((string= (getf item :variable) "subj6")
2280                             (is (= (length (getf item :result)) 1))
2281                             (is (string= (first (getf item :result))
2282                                          "<http://some.where/ii/association>")))
2283                            ((string= (getf item :variable) "pred7")
2284                             (is (= (length (getf item :result)) 3))
2285                             (is-false (set-exclusive-or
2286                                        (list (concat "<" *tms-player* ">")
2287                                              (concat "<" *tms-scope* ">")
2288                                              (concat "<" *instance-psi* ">"))
2289                                        (getf item :result) :test #'string=)))
2290                            ((string= (getf item :variable) "subj7")
2291                             (is (= (length (getf item :result)) 3))
2292                             (is (find "<http://psi.topicmaps.org/tmcl/scope-type>"
2293                                       (getf item :result) :test #'string=))
2294                             (is (find "<http://some.where/ii/goethe-variant>"
2295                                       (getf item :result) :test #'string=)))
2296                            ((string= (getf item :variable) "pred8")
2297                             (is (= (length (getf item :result)) 3))
2298                             (is-false (set-exclusive-or
2299                                        (list (concat "<" *tms-player* ">")
2300                                              (concat "<" *tms-reifier* ">")
2301                                              (concat "<" *instance-psi* ">"))
2302                                        (getf item :result) :test #'string=)))
2303                            ((string= (getf item :variable) "subj8")
2304                             (is (= (length (getf item :result)) 3))
2305                             (set-exclusive-or
2306                              (list "http://some.where/tmsparql/reifier-type"
2307                                    (concat
2308                                     "_:r"
2309                                     (write-to-string
2310                                      (elephant::oid
2311                                       (first
2312                                        (player-in-roles
2313                                         (get-item-by-item-identifier
2314                                          "http://some.where/ii/role-reifier"
2315                                          :revision 0) :revision 0))))))
2316                              (getf item :result) :test #'string=))
2317                            (t
2318                             (is-true (format t "bad variable-name found ~a"
2319                                              (getf item :variable))))))
2320           r-1))))
2321
2322
2323(test test-module-15
2324  "Tests the entire module with the file sparql_test.xtm"
2325  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
2326    (tm-sparql:init-tm-sparql)
2327    (let* ((q-1 (concat
2328                 "PREFIX tms:<" *tms* ">
2329                  SELECT * WHERE {
2330                   ?assoc tms:reifier <http://some.where/ii/association-reifier>.
2331                   ?assoc tms:role ?roles.
2332                   ?roles tms:reifier <http://some.where/ii/role-reifier>"
2333                 "}"))
2334           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
2335      (is-true (= (length r-1) 2))
2336      (map 'list #'(lambda(item)
2337                     (cond
2338                       ((string= (getf item :variable) "assoc")
2339                        (is (= (length (getf item :result)) 1))
2340                        (is (string= (first (getf item :result))
2341                                     "<http://some.where/ii/association>")))
2342                       ((string= (getf item :variable) "roles")
2343                        (is (= (length (getf item :result)) 1))
2344                        (is
2345                         (string=
2346                          (first (getf item :result))
2347                          (concat
2348                           "_:r"
2349                           (write-to-string
2350                            (elephant::oid
2351                             (loop for role in
2352                                  (roles
2353                                   (get-item-by-item-identifier
2354                                    "http://some.where/ii/association"
2355                                    :revision 0) :revision 0)
2356                                when (string=
2357                                      (uri (first (psis (player role :revision 0)
2358                                                        :revision 0)))
2359                                      "http://some.where/tmsparql/author/goethe")
2360                                return role)))))))
2361                       (t
2362                        (is-true (format t "bad variable-name found ~a"
2363                                         (getf item :variable))))))
2364           r-1))))
2365
2366
2367(test test-module-16
2368  "Tests the entire module with the file sparql_test.xtm"
2369  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
2370    (tm-sparql:init-tm-sparql)
2371    (let* ((q-1 (concat
2372                 "SELECT * WHERE {
2373                   <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
2374                   FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
2375                   FILTER ?obj1 = 'von Goethe' || ?obj1 = '82'^^" *xml-integer* "
2376                   FILTER (?obj1 = 'von Goethe'^^" *xml-string* " || 82 = ?obj1)
2377                   FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
2378                   FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
2379                 "}"))
2380           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
2381      (is-true (= (length r-1) 2))
2382      (map 'list #'(lambda(item)
2383                     (cond
2384                       ((string= (getf item :variable) "pred1")
2385                        (is (= (length (getf item :result)) 2))
2386                        (is (find "<http://some.where/tmsparql/last-name>"
2387                                  (getf item :result) :test #'string=))
2388                        (is (find "<http://some.where/tmsparql/years>"
2389                                  (getf item :result) :test #'string=)))
2390                       ((string= (getf item :variable) "obj1")
2391                        (is (= (length (getf item :result)) 2))
2392                        (is (find 82 (getf item :result) :test #'tm-sparql::literal=))
2393                        (is (find "von Goethe" (getf item :result)
2394                                  :test #'tm-sparql::literal=)))
2395                       (t
2396                        (is-true (format t "bad variable-name found ~a"
2397                                         (getf item :variable))))))
2398                       
2399           r-1))))
2400
2401
2402(test test-module-17
2403  "Tests the entire module with the file sparql_test.xtm"
2404  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
2405    (tm-sparql:init-tm-sparql)
2406    (let* ((q-1 (concat
2407                 "SELECT ?pred1 ?obj3 ?obj1 WHERE {
2408                   <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
2409                   FILTER isLITERAL(?obj1) && !isLITERAL(?pred1) && ?obj1 = 'von Goethe' || ?obj1 = 82
2410                   FILTER ?pred1 = $pred1 && $obj1 = $obj1 && ?pred1 != ?obj1
2411                   FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe'
2412                   FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1)
2413                   FILTER (DATATYPE(?obj1) = '" *xml-string* "' || DATATYPE(?obj1) = '" *xml-integer* "') && !(DATATYPE(?obj1) = '" *xml-double* "')
2414                   FILTER STR(?obj1) = '82' || ?obj1='von Goethe'
2415                   FILTER ?obj1 = 82 || REGEX(STR(?obj1), 'von G.*')
2416                   ?subj3 <" *tms-value* "> ?obj3.
2417                   FILTER REGEX(?obj3, 'e.+e.+')"
2418                 "}"))
2419           (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
2420      (is-true (= (length r-1) 3))
2421      (map 'list #'(lambda(item)
2422                     (cond
2423                       ((string= (getf item :variable) "pred1")
2424                        (is (= (length (getf item :result)) 2))
2425                        (is (find "<http://some.where/tmsparql/last-name>"
2426                                  (getf item :result) :test #'string=))
2427                        (is (find "<http://some.where/tmsparql/years>"
2428                                  (getf item :result) :test #'string=)))
2429                       ((string= (getf item :variable) "obj1")
2430                        (is (= (length (getf item :result)) 2))
2431                        (is (find 82 (getf item :result) :test #'tm-sparql::literal=))
2432                        (is (find "von Goethe" (getf item :result)
2433                                  :test #'tm-sparql::literal=)))
2434                       ((string= (getf item :variable) "obj3")
2435                        (is (= (length (getf item :result)) 2))
2436                        (is-true (find "Der Zauberlehrling" (getf item :result)
2437                                  :test #'string=))
2438                        (is-true (find "Hat der alte Hexenmeister
2439        sich doch einmal wegbegeben!
2440        ..." (getf item :result) :test #'string=)))
2441                       (t
2442                        (is-true (format t "bad variable-name found ~a"
2443                                         (getf item :variable))))))
2444           
2445           r-1))))
2446
2447
2448
2449(defun run-sparql-tests ()
2450  (it.bese.fiveam:run! 'sparql-test:sparql-tests))
Note: See TracBrowser for help on using the repository browser.