Author: lgiessmann Date: Fri Apr 8 04:49:14 2011 New Revision: 426 Log: TM-SPARQL: finished the implementation of the SPARQL-API; finished the unit-tests of the SPARQL-API Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp trunk/src/TM-SPARQL/sparql.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp ============================================================================== --- trunk/src/TM-SPARQL/filter_wrappers.lisp (original) +++ trunk/src/TM-SPARQL/filter_wrappers.lisp Fri Apr 8 04:49:14 2011 @@ -10,7 +10,7 @@ (defpackage :filter-functions (:use :base-tools :constants :tm-sparql) - (:import-from :cl progn handler-case let)) + (:import-from :cl progn handler-case let condition)) (defun filter-functions::normalize-value (value) @@ -149,7 +149,8 @@ :case-insensitive-mode case-insensitive :multi-line-mode multi-line :single-line-mode single-line))) - (ppcre:scan scanner local-str))) + (when (ppcre:scan scanner local-str) + t))) (defun filter-functions::write-to-symbol (name-string) @@ -187,11 +188,4 @@ (defun filter-functions::str(x) - ;(if (stringp x) ;TODO: remove - ;(if (and (base-tools:string-starts-with x "<") - ;(base-tools:string-ends-with x ">") - ;(base-tools:absolute-uri-p (subseq x 1 (1- (length x))))) - ;(subseq x 1 (1- (length x))) - ;x) - ;(write-to-string x))) - (write-to-string x)) \ No newline at end of file + (write-to-string x)) \ No newline at end of file Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Fri Apr 8 04:49:14 2011 @@ -511,13 +511,13 @@ (variable-p (cond ((eql what :subject) (and (variable-p (subject construct)) - (value (subject construct)))) + (string= (value (subject construct)) variable-name))) ((eql what :predicate) (and (variable-p (predicate construct)) - (value (predicate construct)))) + (string= (value (predicate construct)) variable-name))) ((eql what :object) (and (variable-p (object construct)) - (value (object construct))))))) + (string= (value (object construct)) variable-name)))))) (when variable-p (remove-null (dotimes (idx (length local-results)) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Fri Apr 8 04:49:14 2011 @@ -2403,18 +2403,45 @@ (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*) (tm-sparql:init-tm-sparql) (let* ((q-1 (concat - "SELECT * WHERE { + "SELECT ?pred1 ?obj3 ?obj1 WHERE { <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1. FILTER isLITERAL(?obj1) && !isLITERAL(?pred1) && ?obj1 = 'von Goethe' || ?obj1 = 82 FILTER ?pred1 = $pred1 && $obj1 = $obj1 && ?pred1 != ?obj1 FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe' FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1) FILTER (DATATYPE(?obj1) = '" *xml-string* "' || DATATYPE(?obj1) = '" *xml-integer* "') && !(DATATYPE(?obj1) = '" *xml-double* "') - FILTER STR(?obj1) = '82' || ?obj1='von Goethe'" + FILTER STR(?obj1) = '82' || ?obj1='von Goethe' + FILTER ?obj1 = 82 || REGEX(STR(?obj1), 'von G.*') + ?subj3 <" *tms-value* "> ?obj3. + FILTER REGEX(?obj3, 'e.+e.+')" "}")) (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) - ;(is-true (= (length r-1) 2)) - (format t "~a~%" r-1)))) + (is-true (= (length r-1) 3)) + (map 'list #'(lambda(item) + (cond + ((string= (getf item :variable) "pred1") + (is (= (length (getf item :result)) 2)) + (is (find "<http://some.where/tmsparql/last-name>" + (getf item :result) :test #'string=)) + (is (find "<http://some.where/tmsparql/years>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 2)) + (is (find 82 (getf item :result) :test #'tm-sparql::literal=)) + (is (find "von Goethe" (getf item :result) + :test #'tm-sparql::literal=))) + ((string= (getf item :variable) "obj3") + (is (= (length (getf item :result)) 2)) + (is-true (find "Der Zauberlehrling" (getf item :result) + :test #'string=)) + (is-true (find "Hat der alte Hexenmeister + sich doch einmal wegbegeben! + ..." (getf item :result) :test #'string=))) + (t + (is-true (format t "bad variable-name found ~a" + (getf item :variable)))))) + + r-1))))