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))