[isidorus-cvs] r341 - in trunk/src: TM-SPARQL unit_tests

Author: lgiessmann Date: Thu Nov 18 15:04:16 2010 New Revision: 341 Log: fixed several bugs in the processing of PREFIX-statements Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Thu Nov 18 15:04:16 2010 @@ -18,7 +18,7 @@ (defclass SPARQL-Query () - ((original-query :initarg :original-query + ((original-query :initarg :query :reader original-query :type String :initform (error @@ -29,6 +29,7 @@ (prefix-list :initarg :prefix-list :reader prefix-list :type List + :initform nil :documentation "A list of the form ((:label 'id' :value 'prefix'))") (variables :initarg :variables @@ -48,10 +49,10 @@ (:documentation "Adds the new prefix tuple to the list of all existing. If there already exists a tuple with the same label the label's value will be overwritten by the new value.") - (:method ((construct SPARQL-Query) (prefix-label Symbol) (prefix-value String)) + (:method ((construct SPARQL-Query) (prefix-label String) (prefix-value String)) (let ((existing-tuple (find-if #'(lambda(x) - (eql (getf x :label) prefix-label)) + (string= (getf x :label) prefix-label)) (prefix-list construct)))) (if existing-tuple (setf (getf existing-tuple :value) prefix-value) @@ -62,5 +63,5 @@ (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) - (parser-start construct) + (parser-start construct (original-query construct)) construct) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Thu Nov 18 15:04:16 2010 @@ -26,10 +26,10 @@ (:method ((construct SPARQL-Query) (query-string String)) (let ((trimmed-query-string (trim-whitespace-left query-string))) (cond ((string-starts-with trimmed-query-string "SELECT") - (parse-prefixes construct - (string-after trimmed-query-string "SELECT"))) + nil) ;;TODO: implement ((string-starts-with trimmed-query-string "PREFIX") - nil) ;TODO: implement + (parse-prefixes construct + (string-after trimmed-query-string "PREFIX"))) ((string-starts-with trimmed-query-string "BASE") nil) ;TODO: implement (t @@ -52,6 +52,9 @@ (next-query-str (trim-whitespace-left (string-after trimmed-string ":"))) (results (parse-bracket-value next-query-str construct))) + (when (string= label-name trimmed-string) + (error (make-sparql-parser-condition + trimmed-string (original-query construct) ":"))) (add-prefix construct label-name (getf results :value)) (parser-start construct (getf results :query-string))))))) @@ -63,12 +66,9 @@ (declare (String query-string open close) (SPARQL-Query query-object)) (let ((trimmed-string (trim-whitespace-left query-string))) - (if (and (string-starts-with trimmed-string open) - (> (length (string-after trimmed-string close)) 0)) - (let* ((pref-url - (string-until (string-after trimmed-string open) close)) - (next-query-str - (string-after pref-url close))) + (if (string-starts-with trimmed-string open) + (let* ((pref-url (string-until (string-after trimmed-string open) close)) + (next-query-str (string-after trimmed-string close))) (unless next-query-str (error (make-sparql-parser-condition trimmed-string (original-query query-object) @@ -77,7 +77,7 @@ :value pref-url)) (error (make-sparql-parser-condition trimmed-string (original-query query-object) - open))))) + close))))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Thu Nov 18 15:04:16 2010 @@ -24,5 +24,13 @@ (in-suite sparql-test) +;TODO: prefix tests +;PREFIX foaf : <http://xmlns.com/foaf/0.1/> +;PREFIX org: <http://example.com/ns#> +;PREFIX isi:<http://isidor.us> +;PREFIX :<http://some.where> +;PREFIX foaf : <http://overwrite.foaf>" + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests)) \ No newline at end of file
participants (1)
-
Lukas Giessmann