[isidorus-cvs] r413 - in trunk/src: TM-SPARQL base-tools unit_tests

Author: lgiessmann Date: Tue Apr 5 05:31:40 2011 New Revision: 413 Log: changed the behavior of the handling of paranthesis and quotations in filters and the behavior of hanlding SPARQL comments 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 Tue Apr 5 05:31:40 2011 @@ -377,6 +377,9 @@ (:documentation "Processes all filters by calling invoke-filter.") (:method ((construct SPARQL-Query)) (dolist (filter (filters construct)) + + (format t ">>>~a<<<~%" filter) ;TODO: remove + (let* ((filter-variable-names (get-variables-from-filter-string filter)) (filter-variable-values nil) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Apr 5 05:31:40 2011 @@ -38,7 +38,10 @@ (if (string-starts-with trimmed-str "#") (let ((next-query (string-after trimmed-str (string #\newline)))) (if next-query - next-query + (let ((cleaned-next-query (cut-comment next-query))) + (if (string= next-query cleaned-next-query) + next-query + (cut-comment next-query))) "")) trimmed-str))) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Tue Apr 5 05:31:40 2011 @@ -437,25 +437,35 @@ (Integer pos)) (let ((result nil)) (dotimes (idx (length filter-string) result) - (let ((current-char (subseq filter-string idx (1+ idx)))) - (cond ((or (string= current-char "'") - (string= current-char "\"")) - (let* ((l-result (get-literal (subseq filter-string idx))) - (next-idx - (when l-result - (- (length filter-string) - (length (getf l-result :next-string)))))) - (when (and next-idx (< pos next-idx)) - (setf result t) - (setf idx (length filter-string))) - (when (<= pos idx) - (setf idx (length filter-string))))) - (t - (when (<= pos idx) - (setf idx (length filter-string))))))))) + (let* ((current-str (subseq filter-string idx)) + (delimiter (cond ((string-starts-with current-str "'''") + "'''") + ((string-starts-with current-str "'") + "'") + ((string-starts-with current-str "\"\"\"") + "\"\"\"") + ((string-starts-with current-str "\"") + "\"")))) + (when delimiter + (let* ((end-pos + (let ((result + (search-first (list delimiter) + (subseq current-str (length delimiter))))) + (when result + (+ (length delimiter) result)))) + (quoted-str (when end-pos + (subseq current-str (length delimiter) end-pos))) + (start-pos idx)) + (incf idx (+ (* 2 (length delimiter)) (length quoted-str))) + (if (and (>= pos start-pos) + (<= pos (+ start-pos end-pos))) + (progn + (setf result t) + (setf idx (length filter-string))) + (incf idx (+ (* 2 (length delimiter)) (length quoted-str)))))))))) -(defun search-first-unclosed-paranthesis (str &key ignore-literals) +(defun search-first-unclosed-paranthesis (str &key (ignore-literals t)) "Returns the idx of the first ( that is not closed, the search is started from the end of the string. If ignore-literals is set to t all paranthesis that are within @@ -467,12 +477,14 @@ (do ((idx (1- (length str)))) ((< idx 0)) (let ((current-char (subseq str idx (1+ idx)))) (cond ((string= current-char ")") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (decf open-brackets))) ((string= current-char "(") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (incf open-brackets) (when (> open-brackets 0) (setf result-idx idx) @@ -481,7 +493,7 @@ result-idx)) -(defun search-first-unopened-paranthesis (str &key ignore-literals) +(defun search-first-unopened-paranthesis (str &key (ignore-literals t)) "Returns the idx of the first paranthesis that is not opened in str. If ignore-literals is set to t all mparanthesis that are within \", \"\"\", ' and ''' are ignored." @@ -492,13 +504,15 @@ (dotimes (idx (length str)) (let ((current-char (subseq str idx (1+ idx)))) (cond ((string= current-char "(") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (decf closed-brackets) (setf result-idx nil))) ((string= current-char ")") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (incf closed-brackets) (when (> closed-brackets 0) (setf result-idx idx) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Apr 5 05:31:40 2011 @@ -2339,6 +2339,52 @@ r-1)))) +(test test-all-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) + (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' || 82 = ?obj1) + #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1) + #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))" + " +}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + + + + ;;TODO: use all stored literal datatype information if existent and + ;; cast the values to the actual objects + ;; or + ;; write all string values to the results in a quoted form, + ;; it is also needed to escapte quotes in the actual string value + ;; the filter is called with read-from-string, so a "12" will evaluate + ;; to 12 and "\"abc\"" to "abc + + (map 'list #'(lambda(triple) + (format t "~a - ~a - ~a~%" + (tm-sparql::subject-result triple) + (tm-sparql::predicate-result triple) + (tm-sparql::object-result triple))) + (tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))) + + + + (is-true (= (length r-1) 2)) + (map 'list #'(lambda(item) + (cond + ((string= (getf item :variable) "pred1") + nil) + ((string= (getf item :variable) "obj1") + nil))) + r-1) + (format t "~a~%" r-1)))) + + ;TODO: test complex filters
participants (1)
-
Lukas Giessmann