[isidorus-cvs] r413 - in trunk/src: TM-SPARQL base-tools unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Apr 5 09:31:40 UTC 2011
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
More information about the Isidorus-cvs
mailing list