[isidorus-cvs] r417 - in trunk/src: TM-SPARQL base-tools unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Apr 6 09:26:02 UTC 2011
Author: lgiessmann
Date: Wed Apr 6 05:26:02 2011
New Revision: 417
Log:
TM-SPARQL: adopted all unit-tests to the latest changes; fixed some bug that handles unsupported datatypes
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/base-tools/base-tools.lisp
trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Wed Apr 6 05:26:02 2011
@@ -589,7 +589,7 @@
(list :subject subj-uri
:predicate pred-uri
:object (charvalue char)
- :literal-datatype literal-datatype))))
+ :literal-datatype literal-datatype))))
(remove-if #'(lambda(char)
(typep char 'VariantC))
(return-characteristics literal-value literal-datatype)))))
@@ -909,8 +909,10 @@
(string/= literal-datatype *xml-boolean*))
construct
(handler-case
- (let ((occ-value (cast-literal (charvalue construct)
- (datatype construct))))
+ (let ((occ-value
+ (cast-literal (charvalue construct)
+ (datatype construct)
+ :back-as-string-when-unsupported t)))
(when (literal= occ-value literal-value)
construct))
(condition () nil)))))
@@ -1279,10 +1281,12 @@
values)))
-(defun cast-literal (literal-value literal-type)
+(defun cast-literal (literal-value literal-type
+ &key (back-as-string-when-unsupported nil))
"A helper function that casts the passed string value of the literal
corresponding to the passed literal-type."
- (declare (String literal-value literal-type))
+ (declare (String literal-value literal-type)
+ (Boolean back-as-string-when-unsupported))
(cond ((string= literal-type *xml-string*)
literal-value)
((string= literal-type *xml-boolean*)
@@ -1294,7 +1298,9 @@
((string= literal-type *xml-decimal*)
(cast-literal-to-decimal literal-value))
(t ; return the value as a string
- (concat "\"\"\"" literal-value "\"\"\"^^" literal-type))))
+ (if back-as-string-when-unsupported
+ literal-value
+ (concat "\"\"\"" literal-value "\"\"\"^^" literal-type)))))
(defun cast-literal-to-decimal (literal-value)
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Wed Apr 6 05:26:02 2011
@@ -230,7 +230,8 @@
(l-lang (getf result-2 :lang))
(next-query (getf result-2 :next-query)))
(list :next-query next-query :lang l-lang :type l-type
- :value (cast-literal l-value l-type)))))
+ :value (cast-literal l-value l-type
+ :back-as-string-when-unsupported t)))))
(defgeneric separate-literal-lang-or-type (construct query-string)
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Wed Apr 6 05:26:02 2011
@@ -195,12 +195,15 @@
(let ((search-idx (search-first (list string-to-replace) main-string)))
(if (not search-idx)
main-string
- (let ((modified-string
- (concat (subseq main-string 0 search-idx)
- new-string
- (subseq main-string
- (+ search-idx (length string-to-replace))))))
- (string-replace modified-string string-to-replace new-string))))))
+ (let* ((leading-part (subseq main-string 0 search-idx))
+ (trailing-part
+ (subseq main-string
+ (+ search-idx (length string-to-replace))))
+ (modified-string
+ (concat leading-part new-string trailing-part)))
+ (if (search-first (list string-to-replace) trailing-part)
+ (string-replace modified-string string-to-replace new-string)
+ modified-string))))))
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Wed Apr 6 05:26:02 2011
@@ -41,20 +41,20 @@
:test-set-functions
:test-module-1
:test-module-2
- :test-all-1
- :test-all-2
- :test-all-3
- :test-all-4
- :test-all-5
- :test-all-6
- :test-all-7
- :test-all-8
- :test-all-9
- :test-all-10
- :test-all-11
- :test-all-12
- :test-all-13
- :test-all-14))
+ :test-module-3
+ :test-module-4
+ :test-module-5
+ :test-module-6
+ :test-module-7
+ :test-module-8
+ :test-module-9
+ :test-module-10
+ :test-module-11
+ :test-module-12
+ :test-module-13
+ :test-module-14
+ :test-module-15
+ :test-module-16))
(in-package :sparql-test)
@@ -1603,7 +1603,7 @@
(is-false (set-exclusive-or
(getf (second result-2) :result)
(list "Johann Wolfgang" "von Goethe"
- "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")
+ (concat "\"\"\"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe\"\"\"^^" *xml-uri*))
:test #'string=)))
(progn
(is (= (length (getf (second result-2) :result)) 0))
@@ -1612,7 +1612,7 @@
(is-false (set-exclusive-or
(getf (first result-2) :result)
(list "Johann Wolfgang" "von Goethe"
- "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")
+ (concat "\"\"\"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe\"\"\"^^" *xml-uri*))
:test #'string=))))))))
@@ -1642,7 +1642,7 @@
:test #'string=))))))
-(test test-all-1
+(test test-module-3
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1698,7 +1698,7 @@
(is-true (d:get-item-by-psi *rdf-type* :revision 0))))
-(test test-all-2
+(test test-module-4
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1724,7 +1724,7 @@
r-1))))
-(test test-all-3
+(test test-module-5
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1752,7 +1752,7 @@
r-1))))
-(test test-all-4
+(test test-module-6
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1802,7 +1802,7 @@
r-1))))
-(test test-all-5
+(test test-module-7
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1831,7 +1831,7 @@
r-1))))
-(test test-all-6
+(test test-module-8
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1874,7 +1874,7 @@
r-1))))
-(test test-all-7
+(test test-module-9
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1898,7 +1898,7 @@
r-1))))
-(test test-all-8
+(test test-module-10
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1921,7 +1921,8 @@
"Johann Wolfgang von Goethe")))
((string= (getf item :variable) "obj2")
(is (string= (first (getf item :result))
- "28.08.1749")))
+ (concat "\"\"\"28.08.1749\"\"\"^^"
+ *xml-date*))))
((string= (getf item :variable) "obj3")
(is (string= (first (getf item :result))
"Goethe")))
@@ -1942,7 +1943,7 @@
r-1))))
-(test test-all-9
+(test test-module-11
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -1961,7 +1962,7 @@
(is-false r-1))))
-(test test-all-10
+(test test-module-12
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -2074,7 +2075,7 @@
r-1))))
-(test test-all-11
+(test test-module-13
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -2127,24 +2128,27 @@
((string= (getf item :variable) "obj1")
(is (= (length (getf item :result)) 17))
(is-true (find "Johann Wolfgang" (getf item :result)
- :test #'string=))
+ :test #'tm-sparql::literal=))
(is-true (find "von Goethe" (getf item :result)
- :test #'string=))
- (is-true (find "true" (getf item :result)
- :test #'string=))
- (is-true (find "false" (getf item :result)
- :test #'string=))
- (is-true (find "28.08.1749" (getf item :result)
- :test #'string=))
- (is-true (find "22.03.1832" (getf item :result)
- :test #'string=))
- (is-true (find "82" (getf item :result)
- :test #'string=))
+ :test #'tm-sparql::literal=))
+ (is-true (find t (getf item :result)
+ :test #'tm-sparql::literal=))
+ (is-true (position nil (getf item :result)
+ :test #'tm-sparql::literal=))
+ (is-true (find (concat "'28.08.1749'^^" *xml-date*)
+ (getf item :result)
+ :test #'tm-sparql::literal=))
+ (is-true (find (concat "'22.03.1832'^^" *xml-date*)
+ (getf item :result)
+ :test #'tm-sparql::literal=))
+ (is-true (find 82 (getf item :result)
+ :test #'tm-sparql::literal=))
(is-true (find "<http://some.where/tmsparql/author>"
- (getf item :result) :test #'string=))
+ (getf item :result)
+ :test #'tm-sparql::literal=))
(is-true
(find "<http://some.where/psis/poem/zauberlehrling>"
- (getf item :result) :test #'string=)))
+ (getf item :result) :test #'tm-sparql::literal=)))
((string= (getf item :variable) "obj2")
(is (= (length (getf item :result)) 3))
(is-false
@@ -2182,9 +2186,9 @@
(is-false
(set-exclusive-or
(getf item :result)
- (list "28.08.1749"
+ (list (concat "'28.08.1749'^^" *xml-date*)
"<http://some.where/ii/goethe-occ-reifier>")
- :test #'string=)))
+ :test #'tm-sparql::literal=)))
((string= (getf item :variable) "obj6")
(is (= (length (getf item :result)) 2))
(is-false
@@ -2198,7 +2202,7 @@
r-1))))
-(test test-all-12
+(test test-module-14
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -2312,7 +2316,7 @@
-(test test-all-13
+(test test-module-15
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
@@ -2353,14 +2357,14 @@
r-1))))
-(test test-all-14
+(test test-module-16
"Tests the entire module with the file sparql_test.xtm"
(with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
(tm-sparql:init-tm-sparql)
(let* ((q-1 (concat
"SELECT * WHERE {
<http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
- FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+ FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
@@ -2393,8 +2397,6 @@
;TODO: cast literal-values when called in filters
;TODO: test complex filters
-;TODO: check if object results are in the actual object-represenrtation and not as string
-;TODO: rename test-all-? test-module-?
(defun run-sparql-tests ()
(it.bese.fiveam:run! 'sparql-test:sparql-tests))
More information about the Isidorus-cvs
mailing list