[isidorus-cvs] r368 - in trunk/src: TM-SPARQL base-tools unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Fri Dec 17 11:55:26 UTC 2010
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 ()
More information about the Isidorus-cvs
mailing list