- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r374 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Sat Dec 18 05:45:40 2010 New Revision: 374 Log: TM-SPARQL: added the handling of supported filter function => added unit-tests => fixed several bug with white space characters 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 Sat Dec 18 05:45:40 2010 @@ -102,39 +102,89 @@ (filter-string-arithmetic-ops (set-arithmetic-operators construct filter-string-or-and-ops)) (filter-string-compare-ops - (set-compare-operators construct filter-string-arithmetic-ops))) - filter-string-compare-ops))) + (set-compare-operators construct filter-string-arithmetic-ops)) + (filter-string-functions + (set-functions construct filter-string-compare-ops))) + filter-string-functions))) ;;TODO: implement - ;; **replace () by (progn ) - ;; **replace ', """, ''' by " - ;; **replace !x by (not x) - ;; **replace +x by (one+ x) - ;; **replace -x by (one- x) - ;; **||, && - ;; **, / - ;; **+, - - ;; **=, !=, <, >, <=, >= - ;; *replace function(x), function(x, y), function(x, y, z) - ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) ;; *check if all functions that will be invoked are allowed - ;; *embrace the final result uris in <> => unit-tests + ;; *implement wrapper functions, also for the operators + ;; it would be nice of the self defined operator functions would be in a + ;; separate packet, e.g. filter-functions, so =, ... would couse no + ;; collisions + ;; *embrace the final results uris in <> => unit-tests ;; *create and store this filter object => store the created string and implement ;; a method "invoke-filter(SPARQL-Triple filter-string)" so that the variables ;; are automatically contained in a letafterwards the eval function can be called ;; this method should also have a let with (true t) and (false nil) -(defvar *tmp* 0) +(defgeneric set-functions (construct filter-string) + (:documentation "Transforms all supported functions of the form + function(x, y) to (function x y).") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((op-pos (find-functions filter-string))) + (if (not op-pos) + filter-string + (let* ((fun-name + (return-if-starts-with (subseq filter-string op-pos) + *supported-functions*)) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string + (+ op-pos (length fun-name)))) + (cleaned-right-str (trim-whitespace-left right-str)) + (arg-list (bracket-scope cleaned-right-str)) + (cleaned-arg-list (clean-function-arguments arg-list)) + (modified-str + (concatenate + 'string left-str "(" fun-name " " cleaned-arg-list ")" + (subseq right-str (+ (- (length right-str) + (length cleaned-right-str)) + (length arg-list)))))) + (set-functions construct modified-str)))))) + + +(defun clean-function-arguments (argument-string) + "Transforms all arguments within an argument list of the form + (x, y, z, ...) to x y z." + (declare (String argument-string)) + (when (and (string-starts-with argument-string "(") + (string-ends-with argument-string ")")) + (let ((local-str (subseq argument-string 1 (1- (length argument-string)))) + (result "")) + (dotimes (idx (length local-str) result) + (let ((current-char (subseq local-str idx (1+ idx)))) + (if (and (string= current-char ",") + (not (in-literal-string-p local-str idx))) + (push-string " " result) + (push-string current-char result))))))) + + +(defun find-functions (filter-string) + "Returns the idx of the first found 'BOUND', 'isLITERAL', 'STR', + 'DATATYPE', or 'REGEX'. + It must not be in a literal string or directly after a (." + (declare (String filter-string)) + (let* ((first-pos + (search-first-ignore-literals *supported-functions* + filter-string))) + (when first-pos + (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos)))) + (if (not (string-ends-with left-part "(")) + first-pos + (let ((next-pos + (find-functions (subseq filter-string (1+ first-pos))))) + (when next-pos + (+ 1 first-pos next-pos)))))))) + + (defgeneric set-compare-operators (construct filter-string) (:documentation "Transforms the =, !=, <, >, <= and >= operators in the filter string to the the corresponding lisp functions.") (:method ((construct SPARQL-Query) (filter-string String)) - (incf *tmp*) (let ((op-pos (find-compare-operators filter-string))) - (if (or (not op-pos) (= *tmp* 5)) - (progn - (setf *tmp* 0) - filter-string) + (if (not op-pos) + filter-string (let* ((op-str (if (string-starts-with-one-of (subseq filter-string op-pos) (*2-compare-operators*)) @@ -335,8 +385,8 @@ string to the the corresponding lisp functions.") (:method ((construct SPARQL-Query) (filter-string String)) (let ((op-pos (find-+--operators filter-string))) - (if (or (not op-pos) (= *tmp* 5)) - filter-string + (if (not op-pos) + filter-string (let* ((op-str (subseq filter-string op-pos (1+ op-pos))) (left-str (subseq filter-string 0 op-pos)) (right-str (subseq filter-string (1+ op-pos))) @@ -438,7 +488,7 @@ filter-string (let* ((op-str (subseq filter-string op-pos (+ 2 op-pos))) (left-str (subseq filter-string 0 op-pos)) - (right-str (subseq filter-string (+ 2 op-pos))) + (right-str (subseq filter-string (+ (length op-str) op-pos))) (left-scope (find-or-and-left-scope left-str)) (right-scope (find-or-and-right-scope right-str)) (modified-str @@ -567,8 +617,8 @@ (trim-whitespace-right (subseq filter-string 0 idx)))) (if (or (string= string-before "") (string-ends-with string-before "(progn") - (string-ends-with-one-of string-before - (*supported-operators*))) + (string-ends-with-one-of + string-before (append (*supported-operators*) (list "(")))) (let ((result (unary-operator-scope filter-string idx))) (push-string (concatenate 'string "(one" current-char " ") result-string) @@ -719,7 +769,7 @@ (progn (setf idx (- (1- (length str)) (length (getf literal :next-string)))) - (push-string (getf literal :literal) str)) + (push-string (getf literal :literal) result)) (progn (setf result nil) (setf idx (length str)))))) @@ -790,7 +840,13 @@ (error (make-sparql-parser-condition (subseq query-string idx) (original-query construct) - "a valid filter, but the filter is not complete"))) + (format nil + "a valid filter, but the filter is not complete, ~a" + (if (> open-brackets 0) + (format nil "~a ')' is missing" + open-brackets) + (format nil "~a '(' is missing" + open-brackets)))))) (setf result (list :next-query (subseq query-string idx) :filter-string filter-string))) @@ -804,7 +860,7 @@ represents a (progn) block." (declare (String query-string) (Integer idx)) - (let* ((delimiters (append (list " " (string #\Space) (string #\Tab) + (let* ((delimiters (append (list " " "," (string #\Space) (string #\Tab) (string #\Newline) (string #\cr) "(" ")") (*supported-operators*))) (string-before (trim-whitespace-right (subseq query-string 0 idx))) @@ -813,8 +869,9 @@ (fragment-before (if (and (not fragment-before-idx) (and (> (length string-before) 0) - (not (find string-before *supported-functions* - :test #'string=)))) + (not (string-ends-with-one-of + (trim-whitespace-right string-before) + *supported-functions*)))) (error (make-condition 'SPARQL-PARSER-ERROR :message (format nil "Invalid filter: \"~a\"~%" @@ -838,16 +895,15 @@ 'SPARQL-PARSER-ERROR :message (format nil "Invalid filter: found \"~a\" but expected ~a" fragment-before *supported-functions*)))) - (when (not (find fragment-before (append *supported-functions* - delimiters) - :test #'string=)) + (when (not (string-starts-with-one-of + fragment-before (append *supported-functions* delimiters))) (error (make-condition 'SPARQL-PARSER-ERROR :message (format nil "Invalid character: \"~a\", expected characters: ~a" fragment-before (append *supported-functions* delimiters))))) - (if (find fragment-before *supported-functions* :test #'string=) + (if (string-ends-with-one-of fragment-before *supported-functions*) nil t)) (if (find string-before *supported-functions* :test #'string=) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Sat Dec 18 05:45:40 2010 @@ -40,7 +40,8 @@ :in-literal-string-p :find-literal-end :get-literal-quotation - :get-literal)) + :get-literal + :return-if-starts-with)) (in-package :base-tools) @@ -506,4 +507,17 @@ (when (> closed-brackets 0) (setf result-idx idx) (setf idx (length str)))))))) - result-idx)) \ No newline at end of file + result-idx)) + + +(defun return-if-starts-with (str to-be-matched &key from-end ignore-case) + "Returns the string that is contained in to-be-matched and that is the + start of the string str." + (declare (String str) + (List to-be-matched) + (Boolean from-end ignore-case)) + (loop for try in to-be-matched + when (if from-end + (string-ends-with str try :ignore-case ignore-case) + (string-starts-with str try :ignore-case ignore-case)) + return try)) \ 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 Sat Dec 18 05:45:40 2010 @@ -36,7 +36,8 @@ :test-set-or-and-operators :test-set-*-and-/-operators :test-set-+-and---operators - :test-set-compare-operators)) + :test-set-compare-operators + :test-set-functions)) (in-package :sparql-test) @@ -1236,7 +1237,7 @@ (test test-set-+-and---operators - "Tests various cases of the function set-*-and-/-operators." + "Tests various cases of the function set-+-and---operators." (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}") (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}") @@ -1319,7 +1320,7 @@ (test test-set-compare-operators - "Tests various cases of the function set-*-and-/-operators." + "Tests various cases of the function set-compare-operators." (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}") (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}") @@ -1429,6 +1430,104 @@ "(or(progn(progn(>=(+12)3)))(progn(=(progn(+(+(progn(-24))5)6))3)))")) (is (string= (string-replace result-6-5 " " "") "(or(progn(!=(<=(>21)0)99))(progntrue))")))) + + +(test test-set-functions + "Tests various cases of the function set-functions" + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "BOUND(( (?var) )) || (isLITERAL($var) && ?var = 'abc')}") + (str-2 + "(REGEX(?var1, '''''', ?var3) || (?var1 > ?var3 && (STR( ?var) = \"abc\")))}") + (str-3 + "STR(DATATYPE(?var3,isLITERAL(x, y))) || +?var1 = -?var2 + ?var2 * ?var3}") + (str-4 "DATATYPE(?var3) ||isLITERAL(+?var1 = -?var2)}") + (str-5 "DATATYPE(?var3) ||(isLITERAL (+?var1 = -?var2))}") + (result-1 + (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string)) + (result-1-2 + (tm-sparql::set-or-and-operators dummy-object result-1 result-1)) + (result-1-3 + (tm-sparql::set-*-and-/-operators dummy-object result-1-2)) + (result-1-4 + (tm-sparql::set-+-and---operators dummy-object result-1-3)) + (result-1-5 + (tm-sparql::set-compare-operators dummy-object result-1-4)) + (result-1-6 + (tm-sparql::set-functions dummy-object result-1-5)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-2 + (tm-sparql::set-or-and-operators dummy-object result-2 result-2)) + (result-2-3 + (tm-sparql::set-*-and-/-operators dummy-object result-2-2)) + (result-2-4 + (tm-sparql::set-+-and---operators dummy-object result-2-3)) + (result-2-5 + (tm-sparql::set-compare-operators dummy-object result-2-4)) + (result-2-6 + (tm-sparql::set-functions dummy-object result-2-5)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-2-1 + (tm-sparql::set-unary-operators dummy-object result-3)) + (result-3-2 + (tm-sparql::set-or-and-operators dummy-object result-3-2-1 result-3)) + (result-3-3 + (tm-sparql::set-*-and-/-operators dummy-object result-3-2)) + (result-3-4 + (tm-sparql::set-+-and---operators dummy-object result-3-3)) + (result-3-5 + (tm-sparql::set-compare-operators dummy-object result-3-4)) + (result-3-6 + (tm-sparql::set-functions dummy-object result-3-5)) + (result-4 + (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string)) + (result-4-2-1 + (tm-sparql::set-unary-operators dummy-object result-4)) + (result-4-2 + (tm-sparql::set-or-and-operators dummy-object result-4-2-1 result-4-2-1)) + (result-4-3 + (tm-sparql::set-*-and-/-operators dummy-object result-4-2)) + (result-4-4 + (tm-sparql::set-+-and---operators dummy-object result-4-3)) + (result-4-5 + (tm-sparql::set-compare-operators dummy-object result-4-4)) + (result-4-6 + (tm-sparql::set-functions dummy-object result-4-5)) + (result-5 + (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string)) + (result-5-2-1 + (tm-sparql::set-unary-operators dummy-object result-5)) + (result-5-2 + (tm-sparql::set-or-and-operators dummy-object result-5-2-1 result-5-2-1)) + (result-5-3 + (tm-sparql::set-*-and-/-operators dummy-object result-5-2)) + (result-5-4 + (tm-sparql::set-+-and---operators dummy-object result-5-3)) + (result-5-5 + (tm-sparql::set-compare-operators dummy-object result-5-4)) + (result-5-6 + (tm-sparql::set-functions dummy-object result-5-5))) + (is-true result-1) (is-true result-1-2) (is-true result-1-3) + (is-true result-1-4) (is-true result-1-5) (is-true result-1-6) + (is-true result-2) (is-true result-2-2) (is-true result-2-3) + (is-true result-2-4) (is-true result-2-5) (is-true result-2-6) + (is-true result-3) (is-true result-3-2) (is-true result-3-3) + (is-true result-3-4) (is-true result-3-5) (is-true result-3-6) + (is-true result-4) (is-true result-4-2) (is-true result-4-3) + (is-true result-4-4) (is-true result-4-5) (is-true result-4-6) + (is-true result-5) (is-true result-5-2) (is-true result-5-3) + (is-true result-5-4) (is-true result-5-5) (is-true result-5-6) + (is (string= (string-replace result-1-6 " " "") + "(or(progn(BOUND(progn(progn?var))))(progn(progn(and(progn(isLITERAL$var))(progn(=?var\"abc\"))))))")) + (is (string= (string-replace result-2-6 " " "") + "(progn(or(progn(REGEX?var1\"\"?var3))(progn(progn(and(progn(>?var1?var3))(progn(progn(=(STR?var)\"abc\"))))))))")) + (is (string= (string-replace result-3-6 " " "") + "(or(progn(STR(DATATYPE?var3(isLITERALxy))))(progn(=(one+?var1)(+(one-?var2)(*?var2?var3)))))")) + (is (string= (string-replace result-4-6 " " "") + "(or(progn(DATATYPE?var3))(progn(isLITERAL(=(one+?var1)(one-?var2)))))")) + (is (string= (string-replace result-5-6 " " "") + "(or(progn(DATATYPE?var3))(progn(progn(isLITERAL(=(one+?var1)(one-?var2))))))"))))

1 0

[isidorus-cvs] r373 - trunk/src/unit_tests
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Sat Dec 18 00:43:43 2010 New Revision: 373 Log: TM-SPARQL: added unit-tests for all compare-operators Modified: trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sat Dec 18 00:43:43 2010 @@ -35,7 +35,8 @@ :test-set-unary-operators :test-set-or-and-operators :test-set-*-and-/-operators - :test-set-+-and---operators)) + :test-set-+-and---operators + :test-set-compare-operators)) (in-package :sparql-test) @@ -1315,6 +1316,119 @@ "(and(prognisLITERAL((/(progn(*(progn(+1\"(13+4*5))\"))3))4)))(progn(progn(or(progn12=(+13(*1415)))(progn(*23)=1)))))")) (is (string= (string-replace result-5-4 " " "") "(or(progn(progn(+12)>=3))(progn(progn(+(+(progn(-24))5)6))=3))")))) + + +(test test-set-compare-operators + "Tests various cases of the function set-*-and-/-operators." + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}") + (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}") + (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}") + (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}") + (str-5 "(1 + 2 >= 3) || ((2 - 4) + 5 + 6) = 3}") + (str-6 "2 > 1 <= 0 != 99 || true}") + (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)) + (result-1-2 + (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1)) + (result-1-3 + (tm-sparql::set-*-and-/-operators dummy-object result-1-2)) + (result-1-4 + (tm-sparql::set-+-and---operators dummy-object result-1-3)) + (result-1-5 + (tm-sparql::set-compare-operators dummy-object result-1-4)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-1 + (tm-sparql::set-unary-operators dummy-object result-2)) + (result-2-2 + (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2)) + (result-2-3 + (tm-sparql::set-*-and-/-operators dummy-object result-2-2)) + (result-2-4 + (tm-sparql::set-+-and---operators dummy-object result-2-3)) + (result-2-5 + (tm-sparql::set-compare-operators dummy-object result-2-4)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-1 + (tm-sparql::set-unary-operators dummy-object result-3)) + (result-3-2 + (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3)) + (result-3-3 + (tm-sparql::set-*-and-/-operators dummy-object result-3-2)) + (result-3-4 + (tm-sparql::set-+-and---operators dummy-object result-3-3)) + (result-3-5 + (tm-sparql::set-compare-operators dummy-object result-3-4)) + (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)) + (result-4-2 + (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4)) + (result-4-3 + (tm-sparql::set-*-and-/-operators dummy-object result-4-2)) + (result-4-4 + (tm-sparql::set-+-and---operators dummy-object result-4-3)) + (result-4-5 + (tm-sparql::set-compare-operators dummy-object result-4-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-5-2 + (tm-sparql::set-or-and-operators dummy-object result-5-1 result-5)) + (result-5-3 + (tm-sparql::set-*-and-/-operators dummy-object result-5-2)) + (result-5-4 + (tm-sparql::set-+-and---operators dummy-object result-5-3)) + (result-5-5 + (tm-sparql::set-compare-operators dummy-object result-5-4)) + (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)) + (result-6-2 + (tm-sparql::set-or-and-operators dummy-object result-6-1 result-6)) + (result-6-3 + (tm-sparql::set-*-and-/-operators dummy-object result-6-2)) + (result-6-4 + (tm-sparql::set-+-and---operators dummy-object result-6-3)) + (result-6-5 + (tm-sparql::set-compare-operators dummy-object result-6-4))) + (is-true result-1) (is-true result-1-1) + (is-true result-1-2) (is-true result-1-3) + (is-true result-2) (is-true result-2-1) + (is-true result-2-2) (is-true result-2-3) + (is-true result-3) (is-true result-3-1) + (is-true result-3-2) (is-true result-3-3) + (is-true result-4) (is-true result-4-1) + (is-true result-4-2) (is-true result-4-3) + (is-true result-1-4) (is-true result-2-4) + (is-true result-3-4) (is-true result-4-4) + (is-true result-5) (is-true result-5-1) + (is-true result-5-2) (is-true result-5-3) + (is-true result-5-4) (is-true result-1-5) + (is-true result-2-5) (is-true result-3-5) + (is-true result-4-5) (is-true result-5-5) + (is-true result-6-1) (is-true result-6-2) + (is-true result-6-3) (is-true result-6-4) + (is-true result-6-5) + (is (string= (string-replace result-1-5 " " "") + "(or(progn(and(progn(=x(+a(*bc))))(progn(=y(+(/a3)(*b2))))))(progn(=0(+(-1214)(/(*23)3)))))")) + (is (string= (string-replace result-2-5 " " "") + "(and(progn(=x2))(progn(+(+(-(+(*(progn(+22))2)(/(*124)2))10)(*2(progn(-123))))(progn(*123)))))")) + (is (string= (string-replace result-3-4 " " "") + "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(+(/xy)(progn(one+1)))))))))(progn(one-1))))")) + (is (string= (string-replace result-4-5 " " "") + "(and(prognisLITERAL((/(progn(*(progn(+1\"(13+4*5))\"))3))4)))(progn(progn(or(progn(=12(+13(*1415))))(progn(=(*23)1))))))")) + (is (string= (string-replace result-5-5 " " "") + "(or(progn(progn(>=(+12)3)))(progn(=(progn(+(+(progn(-24))5)6))3)))")) + (is (string= (string-replace result-6-5 " " "") + "(or(progn(!=(<=(>21)0)99))(progntrue))"))))

1 0

[isidorus-cvs] r372 - trunk/src/TM-SPARQL
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Sat Dec 18 00:22:09 2010 New Revision: 372 Log: TM-SPARQL: added the handling of the >, <, >=, <=, = and != operators Modified: trunk/src/TM-SPARQL/sparql_filter.lisp Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Sat Dec 18 00:22:09 2010 @@ -24,7 +24,7 @@ (defparameter *supported-compare-operators* - (list "=" "!=" "<" "<=" ">" ">=") + (list "!=" "<=" ">=" "=" "<" ">") ;not the order is important! "Contains all supported binary operators.") @@ -36,6 +36,22 @@ (list "!" "+" "-") "Contains all supported unary operators") +(defun *2-compare-operators* () + (remove-null + (map 'list #'(lambda(op) + (when (= (length op) 2) + op)) + *supported-compare-operators*))) + + +(defun *1-compare-operators* () + (remove-null + (map 'list #'(lambda(op) + (when (= (length op) 1) + op)) + *supported-compare-operators*))) + + (defun *supported-arithmetic-operators* () (append *supported-primary-arithmetic-operators* *supported-secundary-arithmetic-operators*)) @@ -74,19 +90,20 @@ (:documentation "A helper functions that returns a filter and the next-query string in the form (:next-query string :filter object).") (:method ((construct SPARQL-Query) (query-string String)) + ;note the order of the invacations is important! (let* ((result-set-boundings (set-boundings construct query-string)) (filter-string (getf result-set-boundings :filter-string)) (next-query (getf result-set-boundings :next-query)) (filter-string-unary-ops (set-unary-operators construct filter-string)) - ;;TODO: encapsulate all binary operator mehtod in the method set-binary-ops (filter-string-or-and-ops (set-or-and-operators construct filter-string-unary-ops filter-string-unary-ops)) (filter-string-arithmetic-ops (set-arithmetic-operators construct filter-string-or-and-ops)) - ) - filter-string-arithmetic-ops))) + (filter-string-compare-ops + (set-compare-operators construct filter-string-arithmetic-ops))) + filter-string-compare-ops))) ;;TODO: implement ;; **replace () by (progn ) ;; **replace ', """, ''' by " @@ -95,8 +112,8 @@ ;; **replace -x by (one- x) ;; **||, && ;; **, / - ;; *+, - - ;; *=, !=, <, >, <=, >= + ;; **+, - + ;; **=, !=, <, >, <=, >= ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) ;; *check if all functions that will be invoked are allowed @@ -107,6 +124,106 @@ ;; this method should also have a let with (true t) and (false nil) +(defvar *tmp* 0) +(defgeneric set-compare-operators (construct filter-string) + (:documentation "Transforms the =, !=, <, >, <= and >= operators in the + filter string to the the corresponding lisp functions.") + (:method ((construct SPARQL-Query) (filter-string String)) + (incf *tmp*) + (let ((op-pos (find-compare-operators filter-string))) + (if (or (not op-pos) (= *tmp* 5)) + (progn + (setf *tmp* 0) + filter-string) + (let* ((op-str (if (string-starts-with-one-of + (subseq filter-string op-pos) + (*2-compare-operators*)) + (subseq filter-string op-pos (+ 2 op-pos)) + (subseq filter-string op-pos (1+ op-pos)))) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string (+ (length op-str) op-pos))) + (left-scope (find-compare-left-scope left-str)) + (right-scope (find-compare-right-scope right-str)) + (modified-str + (concatenate + 'string (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" op-str " " left-scope " " right-scope ")" + (subseq right-str (length right-scope))))) + (set-compare-operators construct modified-str)))))) + + +(defun find-compare-operators (filter-string) + "Returns the idx of the first found =, !=, <, >, <= or >= operator. + It must not be in a literal string or directly after a (." + (declare (String filter-string)) + (let* ((first-pos + (search-first-ignore-literals *supported-compare-operators* + filter-string)) + (delta (if first-pos + (if (string-starts-with-one-of + (subseq filter-string first-pos) + (*2-compare-operators*)) + 2 + 1) + 1))) + (when first-pos + (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos)))) + (if (not (string-ends-with-one-of + left-part (append (*1-compare-operators*) (list "(")))) + first-pos + (let ((next-pos + (find-compare-operators (subseq filter-string (+ delta first-pos))))) + (when next-pos + (+ delta first-pos next-pos)))))))) + + +(defun find-compare-left-scope (left-string) + "Returns the string that is the left part of the binary scope." + (declare (String left-string)) + (let* ((first-bracket + (let ((inner-value (search-first-unclosed-paranthesis left-string))) + (when inner-value + (+ inner-value (1+ (length (name-after-paranthesis + (subseq left-string inner-value)))))))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-right left-string)) + (bracket-scope (reverse-bracket-scope cleaned-str))) + (when bracket-scope + (- (- (length left-string) + (- (length left-string) (length cleaned-str))) + (length bracket-scope))))) + (start-idx (or first-bracket paranthesis-pair-idx 0))) + (subseq left-string start-idx))) + + +(defun find-compare-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-ignore-literals *supported-compare-operators* + right-string)) + (first-bracket + (let ((inner-value (search-first-unopened-paranthesis right-string))) + (when inner-value (1+ inner-value)))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-left right-string)) + (bracket-scope (bracket-scope cleaned-str))) + (when bracket-scope + (+ (- (length right-string) (length cleaned-str)) + (length bracket-scope))))) + (end-idx (cond (paranthesis-pair-idx + paranthesis-pair-idx) + ((and first-pos first-bracket) + (min first-pos first-bracket)) + (first-pos first-pos) + (first-bracket first-bracket) + (t (if (= (length right-string) 0) + 0 + (length right-string)))))) + (subseq right-string 0 end-idx))) + + (defgeneric set-arithmetic-operators (construct filter-string) (:documentation "Transforms the +, -, *, / operators in the filter string to the the corresponding lisp functions.") @@ -237,7 +354,6 @@ (defun find-+--left-scope (left-string) "Returns the string that is the left part of the binary scope." (declare (String left-string)) - ;TODO: adapt (let* ((first-bracket (let ((inner-value (search-first-unclosed-paranthesis left-string))) (when inner-value @@ -245,10 +361,8 @@ (subseq left-string inner-value)))))))) (other-anchor (let ((inner-value - (search-first-ignore-literals - (append *supported-secundary-arithmetic-operators* - *supported-compare-operators*) - left-string :from-end t))) + (search-first-ignore-literals *supported-compare-operators* + left-string :from-end t))) (when inner-value (1+ inner-value)))) (paranthesis-pair-idx @@ -271,7 +385,6 @@ (defun find-+--right-scope (right-string) "Returns the string that is the right part of the binary scope." (declare (String right-string)) - ;TODO: adapt (let* ((first-pos (search-first-ignore-literals (append (*supported-arithmetic-operators*) *supported-compare-operators*)

1 0

[isidorus-cvs] r371 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Fri Dec 17 22:55:28 2010 New Revision: 371 Log: TM-SPARQL: added some unit-tests for the binary + and - operators Modified: trunk/src/TM-SPARQL/sparql_filter.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 22:55:28 2010 @@ -95,7 +95,7 @@ ;; **replace -x by (one- x) ;; **||, && ;; **, / - ;; +, - + ;; *+, - ;; *=, !=, <, >, <=, >= ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) @@ -231,9 +231,6 @@ (length left-scope))) "(" op-str " " left-scope " " right-scope ")" (subseq right-str (length right-scope))))) - ;(format t "fs:_~a_~%os:_~a_~%ls:_~a_~%lc:_~a_~%rs:_~a_~%rc:_~a_~%ms:_~a_~%~%" - ;filter-string op-str left-str left-scope right-str right-scope - ;modified-str) (set-+-and---operators construct modified-str)))))) 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 22:55:28 2010 @@ -34,7 +34,8 @@ :test-set-boundings :test-set-unary-operators :test-set-or-and-operators - :test-set-*-and-/-operators)) + :test-set-*-and-/-operators + :test-set-+-and---operators)) (in-package :sparql-test) @@ -1231,6 +1232,89 @@ "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(/xy)+(progn(one+1))))))))(progn(one-1))))")) (is (string= (string-replace result-4-3 " " "") "(and(prognisLITERAL((/(progn(*(progn1+\"(13+4*5))\")3))4)))(progn(progn(or(progn12=13+(*1415))(progn(*23)=1)))))")))) + + +(test test-set-+-and---operators + "Tests various cases of the function set-*-and-/-operators." + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}") + (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}") + (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}") + (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}") + (str-5 "(1 + 2 >= 3) || ((2 - 4) + 5 + 6) = 3}") + (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)) + (result-1-2 + (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1)) + (result-1-3 + (tm-sparql::set-*-and-/-operators dummy-object result-1-2)) + (result-1-4 + (tm-sparql::set-+-and---operators dummy-object result-1-3)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-1 + (tm-sparql::set-unary-operators dummy-object result-2)) + (result-2-2 + (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2)) + (result-2-3 + (tm-sparql::set-*-and-/-operators dummy-object result-2-2)) + (result-2-4 + (tm-sparql::set-+-and---operators dummy-object result-2-3)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-1 + (tm-sparql::set-unary-operators dummy-object result-3)) + (result-3-2 + (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3)) + (result-3-3 + (tm-sparql::set-*-and-/-operators dummy-object result-3-2)) + (result-3-4 + (tm-sparql::set-+-and---operators dummy-object result-3-3)) + (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)) + (result-4-2 + (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4)) + (result-4-3 + (tm-sparql::set-*-and-/-operators dummy-object result-4-2)) + (result-4-4 + (tm-sparql::set-+-and---operators dummy-object result-4-3)) + (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-5-2 + (tm-sparql::set-or-and-operators dummy-object result-5-1 result-5)) + (result-5-3 + (tm-sparql::set-*-and-/-operators dummy-object result-5-2)) + (result-5-4 + (tm-sparql::set-+-and---operators dummy-object result-5-3))) + (is-true result-1) (is-true result-1-1) + (is-true result-1-2) (is-true result-1-3) + (is-true result-2) (is-true result-2-1) + (is-true result-2-2) (is-true result-2-3) + (is-true result-3) (is-true result-3-1) + (is-true result-3-2) (is-true result-3-3) + (is-true result-4) (is-true result-4-1) + (is-true result-4-2) (is-true result-4-3) + (is-true result-1-4) (is-true result-2-4) + (is-true result-3-4) (is-true result-4-4) + (is-true result-5) (is-true result-5-1) + (is-true result-5-2) (is-true result-5-3) + (is-true result-5-4) + (is (string= (string-replace result-1-4 " " "") + "(or(progn(and(prognx=(+a(*bc)))(progny=(+(/a3)(*b2)))))(progn0=(+(-1214)(/(*23)3))))")) + (is (string= (string-replace result-2-4 " " "") + "(and(prognx=2)(progn(+(+(-(+(*(progn(+22))2)(/(*124)2))10)(*2(progn(-123))))(progn(*123)))))")) + (is (string= (string-replace result-3-4 " " "") + "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(+(/xy)(progn(one+1)))))))))(progn(one-1))))")) + (is (string= (string-replace result-4-4 " " "") + "(and(prognisLITERAL((/(progn(*(progn(+1\"(13+4*5))\"))3))4)))(progn(progn(or(progn12=(+13(*1415)))(progn(*23)=1)))))")) + (is (string= (string-replace result-5-4 " " "") + "(or(progn(progn(+12)>=3))(progn(progn(+(+(progn(-24))5)6))=3))"))))

1 0

[isidorus-cvs] r370 - trunk/src/TM-SPARQL
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Fri Dec 17 22:30:41 2010 New Revision: 370 Log: TM-SPARQL: added the handling of the binary + and - operators Modified: trunk/src/TM-SPARQL/sparql_filter.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 22:30:41 2010 @@ -119,7 +119,9 @@ "Returns the idx of the first found * or / operator. It must not be in a literal string or directly after a (." (declare (String filter-string)) - (let ((first-pos (search-first-ignore-literals (list "*" "/") filter-string))) + (let ((first-pos + (search-first-ignore-literals *supported-primary-arithmetic-operators* + filter-string))) (when first-pos (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos)))) (if (not (string-ends-with left-part "(")) @@ -162,8 +164,7 @@ (other-anchor (let ((inner-value (search-first-ignore-literals - (append *supported-join-operators* - *supported-secundary-arithmetic-operators* + (append *supported-secundary-arithmetic-operators* *supported-compare-operators*) left-string :from-end t))) (when inner-value @@ -189,8 +190,7 @@ "Returns the string that is the right part of the binary scope." (declare (String right-string)) (let* ((first-pos (search-first-ignore-literals - (append *supported-join-operators* - (*supported-arithmetic-operators*) + (append (*supported-arithmetic-operators*) *supported-compare-operators*) right-string)) (first-bracket @@ -217,8 +217,104 @@ (:documentation "Transforms the +, - operators in the filter string to the the corresponding lisp functions.") (:method ((construct SPARQL-Query) (filter-string String)) - ;TODO: implement - filter-string)) + (let ((op-pos (find-+--operators filter-string))) + (if (or (not op-pos) (= *tmp* 5)) + filter-string + (let* ((op-str (subseq filter-string op-pos (1+ op-pos))) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string (1+ op-pos))) + (left-scope (find-+--left-scope left-str)) + (right-scope (find-+--right-scope right-str)) + (modified-str + (concatenate + 'string (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" op-str " " left-scope " " right-scope ")" + (subseq right-str (length right-scope))))) + ;(format t "fs:_~a_~%os:_~a_~%ls:_~a_~%lc:_~a_~%rs:_~a_~%rc:_~a_~%ms:_~a_~%~%" + ;filter-string op-str left-str left-scope right-str right-scope + ;modified-str) + (set-+-and---operators construct modified-str)))))) + + +(defun find-+--left-scope (left-string) + "Returns the string that is the left part of the binary scope." + (declare (String left-string)) + ;TODO: adapt + (let* ((first-bracket + (let ((inner-value (search-first-unclosed-paranthesis left-string))) + (when inner-value + (+ inner-value (1+ (length (name-after-paranthesis + (subseq left-string inner-value)))))))) + (other-anchor + (let ((inner-value + (search-first-ignore-literals + (append *supported-secundary-arithmetic-operators* + *supported-compare-operators*) + left-string :from-end t))) + (when inner-value + (1+ inner-value)))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-right left-string)) + (bracket-scope (reverse-bracket-scope cleaned-str))) + (when bracket-scope + (- (- (length left-string) + (- (length left-string) (length cleaned-str))) + (length bracket-scope))))) + (start-idx (cond (paranthesis-pair-idx + paranthesis-pair-idx) + ((and first-bracket other-anchor) + (max first-bracket other-anchor)) + ((or first-bracket other-anchor) + (or first-bracket other-anchor)) + (t 0)))) + (subseq left-string start-idx))) + + +(defun find-+--right-scope (right-string) + "Returns the string that is the right part of the binary scope." + (declare (String right-string)) + ;TODO: adapt + (let* ((first-pos (search-first-ignore-literals + (append (*supported-arithmetic-operators*) + *supported-compare-operators*) + right-string)) + (first-bracket + (let ((inner-value (search-first-unopened-paranthesis right-string))) + (when inner-value (1+ inner-value)))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-left right-string)) + (bracket-scope (bracket-scope cleaned-str))) + (when bracket-scope + (+ (- (length right-string) (length cleaned-str)) + (length bracket-scope))))) + (end-idx (cond (paranthesis-pair-idx + paranthesis-pair-idx) + ((and first-pos first-bracket) + (min first-pos first-bracket)) + (first-pos first-pos) + (first-bracket first-bracket) + (t (if (= (length right-string) 0) + (1- (length right-string))))))) + (subseq right-string 0 end-idx))) + + +(defun find-+--operators (filter-string) + "Returns the idx of the first found + or - operator. + It must not be in a literal string or directly after a (." + (declare (String filter-string)) + (let ((first-pos + (search-first-ignore-literals *supported-secundary-arithmetic-operators* + filter-string))) + (when first-pos + (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos)))) + (if (and (not (string-ends-with left-part "(one")) + (not (string-ends-with left-part "("))) + first-pos + (let ((next-pos + (find-+--operators (subseq filter-string (1+ first-pos))))) + (when next-pos + (+ 1 first-pos next-pos)))))))) (defgeneric set-or-and-operators (construct filter-string original-filter-string)

1 0

[isidorus-cvs] r369 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 18 Dec '10

18 Dec '10

Author: lgiessmann Date: Fri Dec 17 19:53:11 2010 New Revision: 369 Log: added the handling of * and / => added some unit-tests; fixed a bug with right-scope of && and || operators 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 19:53:11 2010 @@ -15,17 +15,40 @@ "Contains all supported SPARQL-functions") -(defparameter *supported-binary-operators* - (list "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/") +(defparameter *supported-primary-arithmetic-operators* + (list "*" "/") "Contains all supported arithmetic operators.") + + +(defparameter *supported-secundary-arithmetic-operators* + (list "+" "-") "Contains all supported arithmetic operators.") + + +(defparameter *supported-compare-operators* + (list "=" "!=" "<" "<=" ">" ">=") "Contains all supported binary operators.") +(defparameter *supported-join-operators* + (list "||" "&&") "Contains all supported join operators.") + + (defparameter *supported-unary-operators* (list "!" "+" "-") "Contains all supported unary operators") +(defun *supported-arithmetic-operators* () + (append *supported-primary-arithmetic-operators* + *supported-secundary-arithmetic-operators*)) + + +(defun *supported-binary-operators* () + (append (*supported-arithmetic-operators*) + *supported-compare-operators* + *supported-join-operators*)) + + (defun *supported-operators* () - (union *supported-binary-operators* *supported-unary-operators* + (union (*supported-binary-operators*) *supported-unary-operators* :test #'string=)) @@ -56,37 +79,146 @@ (next-query (getf result-set-boundings :next-query)) (filter-string-unary-ops (set-unary-operators construct filter-string)) + ;;TODO: encapsulate all binary operator mehtod in the method set-binary-ops (filter-string-or-and-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)) - - )))) + (filter-string-arithmetic-ops + (set-arithmetic-operators construct filter-string-or-and-ops)) + ) + filter-string-arithmetic-ops))) ;;TODO: implement ;; **replace () by (progn ) ;; **replace ', """, ''' by " ;; **replace !x by (not x) - ;; **replace +x by (1+ x) - ;; **replace -x by (1- x) + ;; **replace +x by (one+ x) + ;; **replace -x by (one- x) ;; **||, && - ;; *=, !=, <, >, <=, >=, +, -, *, / + ;; **, / + ;; +, - + ;; *=, !=, <, >, <=, >= ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) ;; *check if all functions that will be invoked are allowed - ;; *add a let with all variables that are used: every variable with $ and ? prefix - ;; *add a let with (true t) and (false nil) ;; *embrace the final result uris in <> => unit-tests - ;; *create and store this filter object + ;; *create and store this filter object => store the created string and implement + ;; a method "invoke-filter(SPARQL-Triple filter-string)" so that the variables + ;; are automatically contained in a letafterwards the eval function can be called + ;; this method should also have a let with (true t) and (false nil) + + +(defgeneric set-arithmetic-operators (construct filter-string) + (:documentation "Transforms the +, -, *, / operators in the filter + string to the the corresponding lisp functions.") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((filter-string-*/ (set-*-and-/-operators construct filter-string))) + (set-+-and---operators construct filter-string-*/)))) + + +(defun find-*/-operators (filter-string) + "Returns the idx of the first found * or / operator. + It must not be in a literal string or directly after a (." + (declare (String filter-string)) + (let ((first-pos (search-first-ignore-literals (list "*" "/") filter-string))) + (when first-pos + (let ((left-part (trim-whitespace-right (subseq filter-string 0 first-pos)))) + (if (not (string-ends-with left-part "(")) + first-pos + (let ((next-pos + (find-*/-operators (subseq filter-string (1+ first-pos))))) + (when next-pos + (+ 1 first-pos next-pos)))))))) + + +(defgeneric set-*-and-/-operators (construct filter-string) + (:documentation "Transforms the *, / operators in the filter + string to the the corresponding lisp functions.") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((op-pos (find-*/-operators filter-string))) + (if (not op-pos) + filter-string + (let* ((op-str (subseq filter-string op-pos (1+ op-pos))) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string (1+ op-pos))) + (left-scope (find-*/-left-scope left-str)) + (right-scope (find-*/-right-scope right-str)) + (modified-str + (concatenate + 'string (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" op-str " " left-scope " " right-scope ")" + (subseq right-str (length right-scope))))) + (set-*-and-/-operators construct modified-str)))))) + + +(defun find-*/-left-scope (left-string) + "Returns the string that is the left part of the binary scope." + (declare (String left-string)) + (let* ((first-bracket + (let ((inner-value (search-first-unclosed-paranthesis left-string))) + (when inner-value + (+ inner-value (1+ (length (name-after-paranthesis + (subseq left-string inner-value)))))))) + (other-anchor + (let ((inner-value + (search-first-ignore-literals + (append *supported-join-operators* + *supported-secundary-arithmetic-operators* + *supported-compare-operators*) + left-string :from-end t))) + (when inner-value + (1+ inner-value)))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-right left-string)) + (bracket-scope (reverse-bracket-scope cleaned-str))) + (when bracket-scope + (- (- (length left-string) + (- (length left-string) (length cleaned-str))) + (length bracket-scope))))) + (start-idx (cond (paranthesis-pair-idx + paranthesis-pair-idx) + ((and first-bracket other-anchor) + (max first-bracket other-anchor)) + ((or first-bracket other-anchor) + (or first-bracket other-anchor)) + (t 0)))) + (subseq left-string start-idx))) + + +(defun find-*/-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-ignore-literals + (append *supported-join-operators* + (*supported-arithmetic-operators*) + *supported-compare-operators*) + right-string)) + (first-bracket + (let ((inner-value (search-first-unopened-paranthesis right-string))) + (when inner-value (1+ inner-value)))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-left right-string)) + (bracket-scope (bracket-scope cleaned-str))) + (when bracket-scope + (+ (- (length right-string) (length cleaned-str)) + (length bracket-scope))))) + (end-idx (cond (paranthesis-pair-idx + paranthesis-pair-idx) + ((and first-pos first-bracket) + (min first-pos first-bracket)) + (first-pos first-pos) + (first-bracket first-bracket) + (t (if (= (length right-string) 0) + (1- (length right-string))))))) + (subseq right-string 0 end-idx))) -(defgeneric set-binary-operators (construct filter-string) - (:documentation "Transforms the =, !=, <, >, <=, >=, +, -, *, / operators - in the filter string to the the lisp =, /=, <, >, <=, >=, - +, -, * and / functions.") +(defgeneric set-+-and---operators (construct filter-string) + (:documentation "Transforms the +, - operators in the filter + string to the the corresponding lisp functions.") (:method ((construct SPARQL-Query) (filter-string String)) ;TODO: implement - )) + filter-string)) (defgeneric set-or-and-operators (construct filter-string original-filter-string) @@ -94,7 +226,8 @@ the the lisp or and and functions.") (:method ((construct SPARQL-Query) (filter-string String) (original-filter-string String)) - (let ((op-pos (search-first-ignore-literals (list "||" "&&") filter-string))) + (let ((op-pos (search-first-ignore-literals + *supported-join-operators* filter-string))) (if (not op-pos) filter-string (let* ((op-str (subseq filter-string op-pos (+ 2 op-pos))) @@ -122,7 +255,7 @@ (remove-null (map 'list #'(lambda(op-string) (when (= (length op-string) 2) op-string)) - *supported-binary-operators*))) + (*supported-binary-operators*)))) (operator-str (subseq filter-string idx))) (if (string-starts-with-one-of operator-str 2-ops) (subseq operator-str 0 2) @@ -169,22 +302,43 @@ (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-ignore-literals (list "||" "&&") right-string)) + (let* ((first-pos (search-first-ignore-literals + *supported-join-operators* right-string)) (first-bracket (let ((inner-value (search-first-unopened-paranthesis right-string))) (when inner-value (1+ inner-value)))) - (end-idx (cond ((and first-pos first-bracket) - (min first-pos first-bracket)) - (first-pos first-pos) - (first-bracket first-bracket) - (t (if (= (length right-string) 0) - (1- (length right-string))))))) + (paranthesis-pair-idx + (let* ((cleaned-str (trim-whitespace-left right-string)) + (bracket-scope (bracket-scope cleaned-str))) + (when bracket-scope + (+ (- (length right-string) (length cleaned-str)) + (length bracket-scope))))) + (end-idx + (cond ((and first-pos first-bracket) + (if (< first-pos first-bracket) + (if paranthesis-pair-idx + (if (< first-pos paranthesis-pair-idx) + paranthesis-pair-idx + first-pos) + first-pos) + first-bracket)) + (first-bracket first-bracket) + (first-pos + (if paranthesis-pair-idx + (if (< first-pos paranthesis-pair-idx) + paranthesis-pair-idx + first-pos) + first-pos)) + (t + (if (= (length right-string) 0) + 0 + (length right-string)))))) (subseq right-string 0 end-idx))) (defgeneric set-unary-operators (construct filter-string) (:documentation "Transforms the unary operators !, +, - to (not ), - (1+ ) and (1- ). The return value is a modified filter + (one+ ) and (one- ). The return value is a modified filter string.") (:method ((construct SPARQL-Query) (filter-string String)) (let ((result-string "")) @@ -210,7 +364,7 @@ (string-ends-with-one-of string-before (*supported-operators*))) (let ((result (unary-operator-scope filter-string idx))) - (push-string (concatenate 'string "(1" current-char " ") + (push-string (concatenate 'string "(one" current-char " ") result-string) (push-string (set-unary-operators construct (getf result :scope)) @@ -317,6 +471,29 @@ str)))) +(defun reverse-bracket-scope (str &key (open-bracket "(") (close-bracket ")")) + "If str ends with close-bracket there will be returned the substring until + the matching open-bracket is found. Otherwise the return value is nil." + (declare (String str open-bracket close-bracket)) + (when (string-ends-with str close-bracket) + (let ((local-str (subseq str 0 (1- (length str)))) + (result ")") + (close-brackets 1)) + (do ((idx (1- (length local-str)))) ((< idx 0)) + (let ((current-char (subseq local-str idx (1+ idx)))) + (push-string current-char result) + (cond ((string= current-char open-bracket) + (when (not (in-literal-string-p local-str idx)) + (decf close-brackets)) + (when (= close-brackets 0) + (setf idx 0))) + ((string= current-char close-bracket) + (when (not (in-literal-string-p local-str idx)) + (incf close-brackets))))) + (decf idx)) + (reverse result)))) + + (defun bracket-scope (str &key (open-bracket "(") (close-bracket ")")) "If str starts with open-bracket there will be returned the substring until the matching close-bracket is found. Otherwise the return value is nil." 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 19:53:11 2010 @@ -321,19 +321,48 @@ quotation)))))))) -(defun search-first-ignore-literals (search-strings main-string) +;(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 search-first-ignore-literals (search-strings main-string &key from-end) (declare (String main-string) - (List search-strings)) - (let ((first-pos (search-first search-strings main-string))) + (List search-strings) + (Boolean from-end)) + (let ((first-pos + (search-first search-strings main-string :from-end from-end))) (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* ((literal-start + (search-first (list "\"" "'") (subseq main-string 0 first-pos) + :from-end from-end)) + (next-str + (if from-end + + + (subseq main-string 0 literal-start) + + + (let* ((sub-str (subseq main-string literal-start)) + (literal-result (get-literal sub-str))) + (getf literal-result :next-string))))) (let ((next-pos - (search-first-ignore-literals search-strings next-str))) + (search-first-ignore-literals search-strings next-str + :from-end from-end))) (when next-pos (+ (- (length main-string) (length next-str)) next-pos)))))))) @@ -417,7 +446,7 @@ (next-idx (when l-result (- (length filter-string) - (length (getf l-result :next-query)))))) + (length (getf l-result :next-string)))))) (when (and next-idx (< pos next-idx)) (setf result t) (setf idx (length filter-string))) @@ -468,7 +497,8 @@ (cond ((string= current-char "(") (when (or ignore-literals (not (in-literal-string-p str idx))) - (decf closed-brackets))) + (decf closed-brackets) + (setf result-idx nil))) ((string= current-char ")") (when (or ignore-literals (not (in-literal-string-p str idx))) 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 19:53:11 2010 @@ -33,7 +33,8 @@ :test-result :test-set-boundings :test-set-unary-operators - :test-set-or-and-operators)) + :test-set-or-and-operators + :test-set-*-and-/-operators)) (in-package :sparql-test) @@ -1122,20 +1123,22 @@ (is-true result-6-1) (is (string= result-1-1 - "BOUND(?var1)||(progn (not (progn (1+ (progn (1- (progn ?var1)))))))")) + "BOUND(?var1)||(progn (not (progn (one+ (progn (one- (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-5-1 "(not \"a(+c)\") && (progn (1+ 12) = (1- 14))")) + (is (string= result-3-1 "(one+ ?var1)=(one- $var2)")) + (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (one+ 12) = (one- 14))")) + (is (string= result-5-1 "(not \"a(+c)\") && (progn (one+ 12) = (one- 14))")) (is (string= result-6-1 "(not \"abc)def\")")))) (test test-set-or-and-operators - "Tests various cases of the function set-unary-operators." + "Tests various cases of the function set-or-and-operators." (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'}") + (str-4 "(a && (b || c))}") + (str-5 "(b || c) && a}") (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)) @@ -1144,19 +1147,91 @@ (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))) + (result-3-1 (tm-sparql::set-or-and-operators dummy-object result-3 result-3)) + (result-4 + (getf (tm-sparql::set-boundings dummy-object str-4) :filter-string)) + (result-4-1 (tm-sparql::set-or-and-operators dummy-object result-4 result-4)) + (result-5 + (getf (tm-sparql::set-boundings dummy-object str-5) :filter-string)) + (result-5-1 (tm-sparql::set-or-and-operators dummy-object result-5 result-5))) (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-true result-4) + (is-true result-4-1) + (is-true result-5) + (is-true result-5-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)))")) (is (string= (string-replace result-3-1 " " "") - "(and(prognisLITERAL(\"a(bc||def\"))(progn\"abc)def\"))")))) + "(and(prognisLITERAL(\"a(bc||def\"))(progn\"abc)def\"))")) + (is (string= (string-replace result-4-1 " " "") + "(progn(and(progna)(progn(progn(or(prognb)(prognc))))))")) + (is (string= (string-replace result-5-1 " " "") + "(and(progn(progn(or(prognb)(prognc))))(progna))")))) + + +(test test-set-*-and-/-operators + "Tests various cases of the function set-*-and-/-operators." + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "x = a + b * c && y = a / 3 + b * 2 || 0 = 12 - 14 + 2 * 3 / 3}") + (str-2 "x = 2 && (2 + 2) * 2 + 12 * 4 / 2 - 10 + 2 * (12 - 3) + (12 * 3)}") + (str-3 "(x < a || ( a = 4 && 4 = x / y + (+1)) && -1)}") + (str-4 "isLITERAL(((1 + '(13+4*5))') * 3) / 4) && (12 = 13 + 14 * 15 || 2 * 3 = 1)}") + (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)) + (result-1-2 + (tm-sparql::set-or-and-operators dummy-object result-1-1 result-1)) + (result-1-3 + (tm-sparql::set-*-and-/-operators dummy-object result-1-2)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-1 + (tm-sparql::set-unary-operators dummy-object result-2)) + (result-2-2 + (tm-sparql::set-or-and-operators dummy-object result-2-1 result-2)) + (result-2-3 + (tm-sparql::set-*-and-/-operators dummy-object result-2-2)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-1 + (tm-sparql::set-unary-operators dummy-object result-3)) + (result-3-2 + (tm-sparql::set-or-and-operators dummy-object result-3-1 result-3)) + (result-3-3 + (tm-sparql::set-*-and-/-operators dummy-object result-3-2)) + (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)) + (result-4-2 + (tm-sparql::set-or-and-operators dummy-object result-4-1 result-4)) + (result-4-3 + (tm-sparql::set-*-and-/-operators dummy-object result-4-2))) + (is-true result-1) (is-true result-1-1) + (is-true result-1-2) (is-true result-1-3) + (is-true result-2) (is-true result-2-1) + (is-true result-2-2) (is-true result-2-3) + (is-true result-3) (is-true result-3-1) + (is-true result-3-2) (is-true result-3-3) + (is-true result-4) (is-true result-4-1) + (is-true result-4-2) (is-true result-4-3) + (is (string= (string-replace result-1-3 " " "") + "(or(progn(and(prognx=a+(*bc))(progny=(/a3)+(*b2))))(progn0=12-14+(/(*23)3)))")) + (is (string= (string-replace result-2-3 " " "") + "(and(prognx=2)(progn(*(progn2+2)2)+(/(*124)2)-10+(*2(progn12-3))+(progn(*123))))")) + (is (string= (string-replace result-3-3 " " "") + "(progn(and(progn(or(prognx<a)(progn(progn(and(progna=4)(progn4=(/xy)+(progn(one+1))))))))(progn(one-1))))")) + (is (string= (string-replace result-4-3 " " "") + "(and(prognisLITERAL((/(progn(*(progn1+\"(13+4*5))\")3))4)))(progn(progn(or(progn12=13+(*1415))(progn(*23)=1)))))")))) + (defun run-sparql-tests ()

1 0

[isidorus-cvs] r368 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 17 Dec '10

17 Dec '10

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 ()

1 0

[isidorus-cvs] r367 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 16 Dec '10

16 Dec '10

Author: lgiessmann Date: Thu Dec 16 16:07:40 2010 New Revision: 367 Log: TM-SPARQL: adde the hanlding of || and && operators; added also some unit-tests for these cases 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 Thu Dec 16 16:07:40 2010 @@ -15,10 +15,19 @@ "Contains all supported SPARQL-functions") -(defparameter *supported-operators* - (list "!" "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/") - "Contains all supported operators, note some unary operators - are handled as functions, e.g. + and -") +(defparameter *supported-binary-operators* + (list "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/") + "Contains all supported binary operators.") + + +(defparameter *supported-unary-operators* + (list "!" "+" "-") "Contains all supported unary operators") + + +(defun *supported-operators* () + (union *supported-binary-operators* *supported-unary-operators* + :test #'string=)) + (defparameter *supported-brackets* (list "(" ")") @@ -45,25 +54,115 @@ (let* ((result-set-boundings (set-boundings construct query-string)) (filter-string (getf result-set-boundings :filter-string)) (next-query (getf result-set-boundings :next-query)) - (filter-string-unary-ops (set-unary-operators construct filter-string)) + (filter-string-unary-ops + (set-unary-operators construct filter-string)) + (filter-string-or-and-ops + (set-or-and-operators construct filter-string-unary-ops)) )))) ;;TODO: implement - ;; *replace #comment => in set boundings ;; **replace () by (progn ) - ;; **replace ', """, ''' by ''' + ;; **replace ', """, ''' by " ;; **replace !x by (not x) ;; **replace +x by (1+ x) ;; **replace -x by (1- x) - ;; *replace x operator y by (filter-operator x y) - ;; *=, !=, <, >, <=, >=, +, -, *, /, ||, && + ;; **||, && + ;; *=, !=, <, >, <=, >=, +, -, *, / ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) - ;; check if all functions that will be invoked are allowed - ;; add a let with all variables that are used: every variable with $ and ? prefix - ;; add a let with (true t) and (false nil) + ;; *check if all functions that will be invoked are allowed + ;; *add a let with all variables that are used: every variable with $ and ? prefix + ;; *add a let with (true t) and (false nil) + ;; *embrace the final result uris in <> => unit-tests ;; *create and store this filter object +(defgeneric set-or-and-operators (construct 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))) + (if (not op-pos) + filter-string + (let* ((op-str (subseq filter-string op-pos (+ 2 op-pos))) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string (+ 2 op-pos))) + (left-scope (find-or-and-left-scope left-str)) + (right-scope (find-or-and-right-scope right-str)) + (modified-str + (concatenate 'string (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" (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)))))) + + +(defun find-binary-op-string (filter-string idx) + "Returns the operator as string that is placed on the position idx." + (let* ((2-ops + (remove-null (map 'list #'(lambda(op-string) + (when (= (length op-string) 2) + op-string)) + *supported-binary-operators*))) + (operator-str (subseq filter-string idx))) + (if (string-starts-with-one-of operator-str 2-ops) + (subseq operator-str 0 2) + (subseq operator-str 0 1)))) + + +(defun find-or-and-left-scope (left-string) + "Returns the string that is the left part of the binary scope." + (declare (String left-string)) + (let* ((first-bracket + (let ((inner-value (search-first-unclosed-paranthesis left-string))) + (when inner-value + (+ inner-value (1+ (length (name-after-paranthesis + (subseq left-string inner-value)))))))) + (start-idx (if first-bracket + first-bracket + 0))) + (subseq left-string start-idx))) + + +(defun name-after-paranthesis (str) + "Returns the substring that is contained after the paranthesis. + str must start with a ( otherwise the returnvalue is nil." + (declare (String str)) + (let ((result "") + (non-whitespace-found nil)) + (when (string-starts-with str "(") + (let ((cleaned-str (subseq str 1))) + (dotimes (idx (length cleaned-str)) + (let ((current-char (subseq cleaned-str idx (1+ idx)))) + (cond ((string-starts-with-one-of current-char (list "(" ")")) + (setf idx (length cleaned-str))) + ((and non-whitespace-found + (white-space-p current-char)) + (setf idx (length cleaned-str))) + ((white-space-p current-char) + (push-string current-char result)) + (t + (push-string current-char result) + (setf non-whitespace-found t))))) + result)))) + + +(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)) + (first-bracket + (let ((inner-value (search-first-unopened-paranthesis right-string))) + (when inner-value (1+ inner-value)))) + (end-idx (cond ((and first-pos first-bracket) + (min first-pos first-bracket)) + (first-pos first-pos) + (first-bracket first-bracket) + (t (if (= (length right-string) 0) + (1- (length right-string))))))) + (subseq right-string 0 end-idx))) + + (defgeneric set-unary-operators (construct filter-string) (:documentation "Transforms the unary operators !, +, - to (not ), (1+ ) and (1- ). The return value is a modified filter @@ -90,7 +189,7 @@ (if (or (string= string-before "") (string-ends-with string-before "(progn") (string-ends-with-one-of string-before - *supported-operators*)) + (*supported-operators*))) (let ((result (unary-operator-scope filter-string idx))) (push-string (concatenate 'string "(1" current-char " ") result-string) @@ -179,7 +278,7 @@ (declare (String str)) (when (or (string-starts-with str "?") (string-starts-with str "$")) - (let ((found-end (search-first (append (white-space) *supported-operators* + (let ((found-end (search-first (append (white-space) (*supported-operators*) *supported-brackets* (list "?" "$")) (subseq str 1)))) (if found-end @@ -301,7 +400,7 @@ (Integer idx)) (let* ((delimiters (append (list " " (string #\Space) (string #\Tab) (string #\Newline) (string #\cr) "(" ")") - *supported-operators*)) + (*supported-operators*))) (string-before (trim-whitespace-right (subseq query-string 0 idx))) (fragment-before-idx (search-first delimiters string-before :from-end t)) @@ -323,7 +422,7 @@ (> (length fragment-before) (length operator))) (setf fragment-before (string-after fragment-before operator)))) - (append *supported-operators* *supported-brackets*))) + (append (*supported-operators*) *supported-brackets*))) (if fragment-before (progn (when (or (string-starts-with fragment-before "?") Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Thu Dec 16 16:07:40 2010 @@ -12,6 +12,7 @@ (:nicknames :tools) (:export :push-string :when-do + :string-replace :remove-null :full-path :trim-whitespace-left @@ -21,6 +22,7 @@ :string-ends-with :string-ends-with-one-of :string-starts-with-char + :string-starts-with-one-of :string-until :string-after :search-first @@ -30,7 +32,10 @@ :string-after-number :separate-leading-digits :white-space - :escape-string)) + :white-space-p + :escape-string + :search-first-unclosed-paranthesis + :search-first-unopened-paranthesis )) (in-package :base-tools) @@ -63,6 +68,17 @@ nil))) +(defun white-space-p (str) + "Returns t if the passed str contains only white space characters." + (cond ((and (= (length str) 1) + (string-starts-with-one-of str (white-space))) + t) + ((string-starts-with-one-of str (white-space)) + (white-space-p (subseq str 1))) + (t + nil))) + + (defun remove-null (lst) "Removes all null values from the passed list." (remove-if #'null lst)) @@ -118,6 +134,16 @@ (length str-i))))) +(defun string-starts-with-one-of (str prefixes &key (ignore-case nil)) + "Returns t if str ends with one of the string contained in suffixes." + (declare (String str) + (List prefixes) + (Boolean ignore-case)) + (loop for prefix in prefixes + when (string-starts-with str prefix :ignore-case ignore-case) + return t)) + + (defun string-ends-with (str suffix &key (ignore-case nil)) "Checks if string str ends with a given suffix." (declare (String str suffix) @@ -146,6 +172,23 @@ return t)) +(defun string-replace (main-string string-to-replace new-string) + "Replaces every occurrence of string-to-replace by new-string + in main-string." + (declare (String main-string string-to-replace new-string)) + (if (string= string-to-replace new-string) + main-string + (let ((search-idx (search-first (list string-to-replace) main-string))) + (if (not search-idx) + main-string + (let ((modified-string + (concatenate 'string (subseq main-string 0 search-idx) + new-string (subseq main-string + (+ search-idx (length string-to-replace)))))) + (string-replace modified-string string-to-replace new-string)))))) + + + (defun string-starts-with-digit (str) "Checks whether the passed string starts with a digit." (declare (String str)) @@ -153,6 +196,7 @@ when (string-starts-with str (write-to-string item)) return t)) + (defun string-after-number (str) "If str starts with a digit, there is returned the first substring after a character that is a non-digit. @@ -278,4 +322,41 @@ (push-string current-char result)) (t (push-string current-char result))))) - result)) \ No newline at end of file + result)) + + +(defun search-first-unclosed-paranthesis (str) + "Returns the idx of the first ( that is not closed, the search is + started from the end of the string." + (declare (String str)) + (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)) + ((string= current-char "(") + (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)) + (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)) + ((string= current-char ")") + (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 Thu Dec 16 16:07:40 2010 @@ -9,6 +9,7 @@ (defpackage :sparql-test (:use :cl + :base-tools :it.bese.FiveAM :TM-SPARQL :exceptions @@ -31,7 +32,8 @@ :test-set-result-5 :test-result :test-set-boundings - :test-set-unary-operators)) + :test-set-unary-operators + :test-set-or-and-operators)) (in-package :sparql-test) @@ -1112,6 +1114,26 @@ (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (1+ 12) = (1- 14))")))) +(test test-set-or-and-operators + "Tests various cases of the function set-unary-operators." + (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)}") + (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-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))) + (is-true result-1) + (is-true result-1-1) + (is-true result-2) + (is-true result-2-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)))")))) + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

[isidorus-cvs] r366 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 16 Dec '10

16 Dec '10

Author: lgiessmann Date: Thu Dec 16 08:23:10 2010 New Revision: 366 Log: TM-SPARQL: fixed a problem in all filter statements that uses """, ' or ''' and do not escape inner " in literals 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 Thu Dec 16 08:23:10 2010 @@ -58,7 +58,9 @@ ;; *=, !=, <, >, <=, >=, +, -, *, /, ||, && ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) - ;; check if all functions that will e invoked are allowed + ;; check if all functions that will be invoked are allowed + ;; add a let with all variables that are used: every variable with $ and ? prefix + ;; add a let with (true t) and (false nil) ;; *create and store this filter object @@ -121,7 +123,7 @@ (let ((result (get-filter-variable cleaned-str))) (list :next-query (string-after cleaned-str result) :scope result))) - ((string-starts-with cleaned-str "'''") + ((string-starts-with cleaned-str "\"") (let ((result (get-literal cleaned-str))) (list :next-query (getf result :next-query) :scope (getf result :literal)))) @@ -348,7 +350,7 @@ t)))) -(defun get-literal (query-string &key (quotation "'''")) +(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." @@ -366,12 +368,14 @@ ((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)))) + (find-literal-end (subseq query-string 1) + (subseq query-string 0 1)))) (when literal-end - (list :next-query (subseq query-string (+ 1 literal-end)) - :literal (concatenate 'string quotation - (subseq query-string 1 literal-end) - quotation))))))) + (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)) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Thu Dec 16 08:23:10 2010 @@ -29,7 +29,8 @@ :string-starts-with-digit :string-after-number :separate-leading-digits - :white-space)) + :white-space + :escape-string)) (in-package :base-tools) @@ -260,4 +261,21 @@ (position #\: uri))) (declare (string uri)) (and position-of-colon (> position-of-colon 0) - (not (find #\/ (subseq uri 0 position-of-colon))))))) \ No newline at end of file + (not (find #\/ (subseq uri 0 position-of-colon))))))) + + +(defun escape-string (str char-to-escape) + "Escapes every occurrence of char-to-escape in str, if it is + not escaped." + (declare (String str char-to-escape)) + (let ((result "")) + (dotimes (idx (length str)) + (let ((current-char (subseq str idx (1+ idx))) + (previous-char (if (= idx 0) "" (subseq str (1- idx) idx)))) + (cond ((and (string= current-char char-to-escape) + (string/= previous-char "\\")) + (push-string "\\" result) + (push-string current-char result)) + (t + (push-string current-char result))))) + result)) \ 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 Thu Dec 16 08:23:10 2010 @@ -1059,10 +1059,10 @@ (is-true result-1) (is-true result-2) (is (string= (getf result-1 :filter-string) - "BOUND((progn (progn ?var) )) || (progn isLITERAL($var) && ?var = '''abc''')")) + "BOUND((progn (progn ?var) )) || (progn isLITERAL($var) && ?var = \"abc\")")) (is (string= (getf result-1 :next-query) "}")) (is (string= (getf result-2 :filter-string) - "(progn REGEX(?var1, '''''', ?var3) || (progn ?var1 > ?var3 && (progn STR( ?var) = '''abc''')))")) + "(progn REGEX(?var1, \"\", ?var3) || (progn ?var1 > ?var3 && (progn STR( ?var) = \"abc\")))")) (is (string= (getf result-2 :next-query) "}")) (is (string= (getf result-3 :filter-string) "DATATYPE(?var3) || +?var1 = -?var2")) @@ -1081,7 +1081,7 @@ (str-1 "BOUND(?var1)||(!(+(-(?var1))))}") (str-2 "!BOUND(?var1) = false}") (str-3 "+?var1=-$var2}") - (str-4 "!'abc' && (+12 = - 14)}") + (str-4 "!'a\"b\"c' && (+12 = - 14)}") (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)) @@ -1109,7 +1109,7 @@ "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 '''abc''') && (progn (1+ 12) = (1- 14))")))) + (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (1+ 12) = (1- 14))"))))

1 0

[isidorus-cvs] r365 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 15 Dec '10

15 Dec '10

Author: lgiessmann Date: Wed Dec 15 13:08:01 2010 New Revision: 365 Log: TM-SPARQL: added some unit-tests for the handling of \!, -, + as unary opertors => fixed some bugs Modified: trunk/src/TM-SPARQL/sparql_filter.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 Wed Dec 15 13:08:01 2010 @@ -58,6 +58,7 @@ ;; *=, !=, <, >, <=, >=, +, -, *, /, ||, && ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) + ;; check if all functions that will e invoked are allowed ;; *create and store this filter object @@ -115,21 +116,23 @@ (let ((result (bracket-scope cleaned-str))) (list :next-query (string-after cleaned-str result) :scope result))) - ((or (string-starts-with "?" cleaned-str) - (string-starts-with "$" cleaned-str)) + ((or (string-starts-with cleaned-str "?") + (string-starts-with cleaned-str "$")) (let ((result (get-filter-variable cleaned-str))) (list :next-query (string-after cleaned-str result) :scope result))) - ((string-starts-with "'''" cleaned-str) + ((string-starts-with cleaned-str "'''") (let ((result (get-literal cleaned-str))) (list :next-query (getf result :next-query) :scope (getf result :literal)))) ((string-starts-with-digit cleaned-str) - (separate-leading-digits cleaned-str)) - ((string-starts-with "true" cleaned-str) + (let ((result (separate-leading-digits cleaned-str))) + (list :next-query (string-after cleaned-str result) + :scope result))) + ((string-starts-with cleaned-str "true") (list :next-query (string-after cleaned-str "true") :scope "true")) - ((string-starts-with "false" cleaned-str) + ((string-starts-with cleaned-str "false") (list :next-query (string-after cleaned-str "false") :scope "false")) ((let ((pos (search-first *supported-functions* cleaned-str))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Wed Dec 15 13:08:01 2010 @@ -30,7 +30,8 @@ :test-set-result-4 :test-set-result-5 :test-result - :test-set-boundings)) + :test-set-boundings + :test-set-unary-operators)) (in-package :sparql-test) @@ -1073,5 +1074,44 @@ "DATATYPE(?var3) ||(progn isLITERAL (+?var1 = -?var2))")) (is (string= (getf result-5 :next-query) "}")))) + +(test test-set-unary-operators + "Tests various cases of the function set-unary-operators." + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "BOUND(?var1)||(!(+(-(?var1))))}") + (str-2 "!BOUND(?var1) = false}") + (str-3 "+?var1=-$var2}") + (str-4 "!'abc' && (+12 = - 14)}") + (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)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-1 (tm-sparql::set-unary-operators dummy-object result-2)) + (result-3 + (getf (tm-sparql::set-boundings dummy-object str-3) :filter-string)) + (result-3-1 + (tm-sparql::set-unary-operators dummy-object result-3)) + (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))) + (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-true result-4) + (is-true result-4-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 '''abc''') && (progn (1+ 12) = (1- 14))")))) + + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0