Author: lgiessmann Date: Fri Dec 17 06:55:25 2010 New Revision: 368
Log: TM-SPARQL: fixed a bug with ||, &&, !, unary + and - operators => when these operators are contained within literal-strings they are not evaluated anymore => extended the corresponding unit-tests.
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp trunk/src/base-tools/base-tools.lisp trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Fri Dec 17 06:55:25 2010 @@ -57,7 +57,11 @@ (filter-string-unary-ops (set-unary-operators construct filter-string)) (filter-string-or-and-ops - (set-or-and-operators construct filter-string-unary-ops)) + (set-or-and-operators construct filter-string-unary-ops + filter-string-unary-ops)) + (filter-string-binary-ops + (set-binary-operators construct filter-string-or-and-ops)) + )))) ;;TODO: implement ;; **replace () by (progn ) @@ -76,11 +80,21 @@ ;; *create and store this filter object
-(defgeneric set-or-and-operators (construct filter-string) +(defgeneric set-binary-operators (construct filter-string) + (:documentation "Transforms the =, !=, <, >, <=, >=, +, -, *, / operators + in the filter string to the the lisp =, /=, <, >, <=, >=, + +, -, * and / functions.") + (:method ((construct SPARQL-Query) (filter-string String)) + ;TODO: implement + )) + + +(defgeneric set-or-and-operators (construct filter-string original-filter-string) (:documentation "Transforms the || and && operators in the filter string to the the lisp or and and functions.") - (:method ((construct SPARQL-Query) (filter-string String)) - (let ((op-pos (search-first (list "||" "&&") filter-string))) + (:method ((construct SPARQL-Query) (filter-string String) + (original-filter-string String)) + (let ((op-pos (search-first-ignore-literals (list "||" "&&") filter-string))) (if (not op-pos) filter-string (let* ((op-str (subseq filter-string op-pos (+ 2 op-pos))) @@ -94,7 +108,12 @@ "(" (if (string= op-str "||") "or" "and") " " "(progn " left-scope ")" "(progn " right-scope ")) " (subseq right-str (length right-scope))))) - (set-or-and-operators construct modified-str)))))) + (when (or (= (length (trim-whitespace left-scope)) 0) + (= (length (trim-whitespace right-scope)) 0)) + (error (make-condition + 'sparql-parser-error + :message (format nil "Invalid filter: "~a", expect an RDF term after and before: "~a"" original-filter-string op-str)))) + (set-or-and-operators construct modified-str original-filter-string))))))
(defun find-binary-op-string (filter-string idx) @@ -150,7 +169,7 @@ (defun find-or-and-right-scope (right-string) "Returns the string that is the right part of the binary scope." (declare (String right-string)) - (let* ((first-pos (search-first (list "||" "&&") right-string)) + (let* ((first-pos (search-first-ignore-literals (list "||" "&&") right-string)) (first-bracket (let ((inner-value (search-first-unopened-paranthesis right-string))) (when inner-value (1+ inner-value)))) @@ -200,6 +219,18 @@ (setf idx (- (1- (length filter-string)) (length (getf result :next-query))))) (push-string current-char result-string)))) + ((or (string= current-char "'") + (string= current-char """)) + (let* ((sub-str (subseq filter-string idx)) + (quotation (get-literal-quotation sub-str)) + (literal + (get-literal (subseq filter-string idx) :quotation quotation))) + (if literal + (progn + (setf idx (- (1- (length filter-string)) + (length (getf literal :next-string)))) + (push-string (getf literal :literal) result-string)) + (push-string current-char result-string)))) (t (push-string current-char result-string))))) result-string))) @@ -224,7 +255,7 @@ :scope result))) ((string-starts-with cleaned-str """) (let ((result (get-literal cleaned-str))) - (list :next-query (getf result :next-query) + (list :next-query (getf result :next-string) :scope (getf result :literal)))) ((string-starts-with-digit cleaned-str) (let ((result (separate-leading-digits cleaned-str))) @@ -298,21 +329,13 @@ (cond ((or (string= "'" current-char) (string= """ current-char)) (let* ((sub-str (subseq str idx)) - (quotation - (cond ((string-starts-with sub-str "'''") - "'''") - ((string-starts-with sub-str """"") - """"") - ((string-starts-with sub-str "'") - "'") - ((string-starts-with sub-str """) - """))) + (quotation (get-literal-quotation sub-str)) (literal (get-literal (subseq str idx) :quotation quotation))) (if literal (progn (setf idx (- (1- (length str)) - (length (getf literal :next-query)))) + (length (getf literal :next-string)))) (push-string (getf literal :literal) str)) (progn (setf result nil) @@ -366,7 +389,7 @@ (original-query construct) "a closing character for the given literal"))) (setf idx (- (1- (length query-string)) - (length (getf result :next-query)))) + (length (getf result :next-string)))) (push-string (getf result :literal) filter-string))) ((string= "#" current-char) (let ((comment-string @@ -446,50 +469,4 @@ t)) (if (find string-before *supported-functions* :test #'string=) nil - t)))) - - -(defun get-literal (query-string &key (quotation """)) - "Returns a list of the form (:next-query <string> :literal <string> - where next-query is the query after the found literal and literal - is the literal string." - (declare (String query-string) - (String quotation)) - (cond ((or (string-starts-with query-string """"") - (string-starts-with query-string "'''")) - (let ((literal-end - (find-literal-end (subseq query-string 3) (subseq query-string 0 3)))) - (when literal-end - (list :next-query (subseq query-string (+ 3 literal-end)) - :literal (concatenate 'string quotation - (subseq query-string 3 literal-end) - quotation))))) - ((or (string-starts-with query-string """) - (string-starts-with query-string "'")) - (let ((literal-end - (find-literal-end (subseq query-string 1) - (subseq query-string 0 1)))) - (when literal-end - (let ((literal - (escape-string (subseq query-string 1 literal-end) """))) - (list :next-query (subseq query-string (+ 1 literal-end)) - :literal (concatenate 'string quotation literal - quotation)))))))) - - -(defun find-literal-end (query-string delimiter &optional (overall-pos 0)) - "Returns the end of the literal corresponding to the passed delimiter - string. The query-string must start after the opening literal delimiter. - The return value is an int that represents the start index of closing - delimiter. delimiter must be either ", ', or '''. - If the returns value is nil, there is no closing delimiter." - (declare (String query-string delimiter) - (Integer overall-pos)) - (let ((current-pos (search delimiter query-string))) - (if current-pos - (if (string-ends-with (subseq query-string 0 current-pos) "\") - (find-literal-end (subseq query-string (+ current-pos - (length delimiter))) - delimiter (+ overall-pos current-pos 1)) - (+ overall-pos current-pos (length delimiter))) - nil))) \ No newline at end of file + t)))) \ No newline at end of file
Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Fri Dec 17 06:55:25 2010 @@ -26,6 +26,7 @@ :string-until :string-after :search-first + :search-first-ignore-literals :concatenate-uri :absolute-uri-p :string-starts-with-digit @@ -35,7 +36,11 @@ :white-space-p :escape-string :search-first-unclosed-paranthesis - :search-first-unopened-paranthesis )) + :search-first-unopened-paranthesis + :in-literal-string-p + :find-literal-end + :get-literal-quotation + :get-literal))
(in-package :base-tools)
@@ -245,8 +250,7 @@ "Returns the position of one of the search-strings. The returned position is the one closest to 0. If no search-string is found, nil is returned." (declare (String main-string) - (List search-strings) - (Boolean from-end)) + (List search-strings)) (let ((positions (remove-null (map 'list #'(lambda(search-str) @@ -259,6 +263,81 @@ (first sorted-positions)))))
+(defun find-literal-end (query-string delimiter &optional (overall-pos 0)) + "Returns the end of the literal corresponding to the passed delimiter + string. The query-string must start after the opening literal delimiter. + The return value is an int that represents the start index of closing + delimiter. delimiter must be either ", ', or '''. + If the returns value is nil, there is no closing delimiter." + (declare (String query-string delimiter) + (Integer overall-pos)) + (let ((current-pos (search delimiter query-string))) + (if current-pos + (if (string-ends-with (subseq query-string 0 current-pos) "\") + (find-literal-end (subseq query-string (+ current-pos + (length delimiter))) + delimiter (+ overall-pos current-pos 1)) + (+ overall-pos current-pos (length delimiter))) + nil))) + + +(defun get-literal-quotation (str) + "Returns ', ''', " or """ when the string starts with a literal delimiter." + (cond ((string-starts-with str "'''") + "'") + ((string-starts-with str """"") + """"") + ((string-starts-with str "'") + "'") + ((string-starts-with str """) + """))) + + +(defun get-literal (query-string &key (quotation """)) + "Returns a list of the form (:next-string <string> :literal <string> + where next-query is the query after the found literal and literal + is the literal string." + (declare (String query-string) + (String quotation)) + (cond ((or (string-starts-with query-string """"") + (string-starts-with query-string "'''")) + (let ((literal-end + (find-literal-end (subseq query-string 3) (subseq query-string 0 3)))) + (when literal-end + (list :next-string (subseq query-string (+ 3 literal-end)) + :literal (concatenate 'string quotation + (subseq query-string 3 literal-end) + quotation))))) + ((or (string-starts-with query-string """) + (string-starts-with query-string "'")) + (let ((literal-end + (find-literal-end (subseq query-string 1) + (subseq query-string 0 1)))) + (when literal-end + (let ((literal + (escape-string (subseq query-string 1 literal-end) """))) + (list :next-string (subseq query-string (+ 1 literal-end)) + :literal (concatenate 'string quotation literal + quotation)))))))) + + +(defun search-first-ignore-literals (search-strings main-string) + (declare (String main-string) + (List search-strings)) + (let ((first-pos (search-first search-strings main-string))) + (when first-pos + (if (not (in-literal-string-p main-string first-pos)) + first-pos + (let* ((literal-start (search-first (list """ "'") main-string)) + (sub-str (subseq main-string literal-start)) + (literal-result (get-literal sub-str)) + (next-str (getf literal-result :next-string))) + (let ((next-pos + (search-first-ignore-literals search-strings next-str))) + (when next-pos + (+ (- (length main-string) (length next-str)) next-pos)))))))) + + (defun concatenate-uri (absolute-ns value) "Returns a string conctenated of the absolut namespace an the given value separated by either '#' or '/'." @@ -325,38 +404,76 @@ result))
-(defun search-first-unclosed-paranthesis (str) +(defun in-literal-string-p(filter-string pos) + "Returns t if the passed pos is within a literal string value." + (declare (String filter-string) + (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-query)))))) + (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))))))))) + + +(defun search-first-unclosed-paranthesis (str &key ignore-literals) "Returns the idx of the first ( that is not closed, the search is - started from the end of the string." - (declare (String str)) + started from the end of the string. + If ignore-literals is set to t all mparanthesis that are within + ", """, ' and ''' are ignored." + (declare (String str) + (Boolean ignore-literals)) (let ((r-str (reverse str)) (open-brackets 0) (result-idx nil)) (dotimes (idx (length r-str)) (let ((current-char (subseq r-str idx (1+ idx)))) (cond ((string= current-char ")") - (decf open-brackets)) + (when (or ignore-literals + (not (in-literal-string-p str idx))) + (decf open-brackets))) ((string= current-char "(") - (incf open-brackets) - (when (> open-brackets 0) - (setf result-idx idx) - (setf idx (length r-str))))))) + (when (or ignore-literals + (not (in-literal-string-p str idx))) + (incf open-brackets) + (when (> open-brackets 0) + (setf result-idx idx) + (setf idx (length r-str)))))))) (when result-idx (- (length str) (1+ result-idx)))))
-(defun search-first-unopened-paranthesis (str) - "Returns the idx of the first paranthesis that is not opened in str." - (declare (String str)) +(defun search-first-unopened-paranthesis (str &key ignore-literals) + "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." + (declare (String str) + (Boolean ignore-literals)) (let ((closed-brackets 0) (result-idx nil)) (dotimes (idx (length str)) (let ((current-char (subseq str idx (1+ idx)))) (cond ((string= current-char "(") - (decf closed-brackets)) + (when (or ignore-literals + (not (in-literal-string-p str idx))) + (decf closed-brackets))) ((string= current-char ")") - (incf closed-brackets) - (when (> closed-brackets 0) - (setf result-idx idx) - (setf idx (length str))))))) + (when (or ignore-literals + (not (in-literal-string-p str idx))) + (incf closed-brackets) + (when (> closed-brackets 0) + (setf result-idx idx) + (setf idx (length str)))))))) result-idx)) \ No newline at end of file
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Fri Dec 17 06:55:25 2010 @@ -1084,6 +1084,8 @@ (str-2 "!BOUND(?var1) = false}") (str-3 "+?var1=-$var2}") (str-4 "!'a"b"c' && (+12 = - 14)}") + (str-5 "!'a(+c)' && (+12 = - 14)}") + (str-6 "!'abc)def'}") (result-1 (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string)) (result-1-1 (tm-sparql::set-unary-operators dummy-object result-1)) @@ -1097,7 +1099,15 @@ (result-4 (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string)) (result-4-1 - (tm-sparql::set-unary-operators dummy-object result-4))) + (tm-sparql::set-unary-operators dummy-object result-4)) + (result-5 + (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string)) + (result-5-1 + (tm-sparql::set-unary-operators dummy-object result-5)) + (result-6 + (getf (tm-sparql::set-boundings dummy-object str-6) :filter-string)) + (result-6-1 + (tm-sparql::set-unary-operators dummy-object result-6))) (is-true result-1) (is-true result-1-1) (is-true result-2) @@ -1106,12 +1116,18 @@ (is-true result-3-1) (is-true result-4) (is-true result-4-1) + (is-true result-5) + (is-true result-5-1) + (is-true result-6) + (is-true result-6-1) (is (string= result-1-1 "BOUND(?var1)||(progn (not (progn (1+ (progn (1- (progn ?var1)))))))")) (is (string= result-2-1 "(not BOUND(?var1)) = false")) (is (string= result-3-1 "(1+ ?var1)=(1- $var2)")) - (is (string= result-4-1 "(not "a\"b\"c") && (progn (1+ 12) = (1- 14))")))) + (is (string= result-4-1 "(not "a\"b\"c") && (progn (1+ 12) = (1- 14))")) + (is (string= result-5-1 "(not "a(+c)") && (progn (1+ 12) = (1- 14))")) + (is (string= result-6-1 "(not "abc)def")"))))
(test test-set-or-and-operators @@ -1119,20 +1135,28 @@ (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) (str-1 "isLITERAL(STR(?var))||?var = 12 && true}") (str-2 "(true != false || !false ) && 12 < 14 || !isLITERAL(?var)}") + (str-3 "isLITERAL('a(bc||def') && 'abc)def'}") (result-1 (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string)) - (result-1-1 (tm-sparql::set-or-and-operators dummy-object result-1)) + (result-1-1 (tm-sparql::set-or-and-operators dummy-object result-1 result-1)) (result-2 (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) - (result-2-1 (tm-sparql::set-or-and-operators dummy-object result-2))) + (result-2-1 (tm-sparql::set-or-and-operators dummy-object result-2 result-2)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-1 (tm-sparql::set-or-and-operators dummy-object result-3 result-3))) (is-true result-1) (is-true result-1-1) (is-true result-2) (is-true result-2-1) + (is-true result-3) + (is-true result-3-1) (is (string= (string-replace result-1-1 " " "") "(and(progn(or(prognisLITERAL(STR(?var)))(progn?var=12)))(progntrue))")) (is (string= (string-replace result-2-1 " " "") - "(or(progn(and(progn(progn(or(progntrue!=false)(progn!false))))(progn12<14)))(progn!isLITERAL(?var)))")))) + "(or(progn(and(progn(progn(or(progntrue!=false)(progn!false))))(progn12<14)))(progn!isLITERAL(?var)))")) + (is (string= (string-replace result-3-1 " " "") + "(and(prognisLITERAL("a(bc||def"))(progn"abc)def"))"))))
(defun run-sparql-tests ()