Author: lgiessmann Date: Sun Nov 21 16:03:08 2010 New Revision: 346
Log: TM-SPARQL: added some unit-tests for parsing of literals => fixed some bugs
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sun Nov 21 16:03:08 2010 @@ -193,8 +193,9 @@ (parse-literal-number-value trimmed-str query-object))))) (list :next-query (getf value-type-lang-query :next-query) :value (list :value (getf value-type-lang-query :value) - :literal-type (getf value-type-lang-query :value) - :type 'LITERAL)))) + :literal-type (getf value-type-lang-query :type) + :type 'LITERAL + :literal-lang (getf value-type-lang-query :lang)))))
(defun parse-literal-string-value (query-string query-object) @@ -209,12 +210,12 @@ (l-value (getf result-1 :literal)) (result-2 (separate-literal-lang-or-type after-literal-value query-object)) - (l-type (getf result-2 :type)) - (l-lang (if (getf result-2 :lang) - (getf result-2 :lang) + (l-type (if (getf result-2 :type) + (getf result-2 :type) *xml-string*)) + (l-lang (getf result-2 :lang)) (next-query (getf result-2 :next-query))) - (list :next-query next-query :lang l-lang :type l-lang + (list :next-query next-query :lang l-lang :type l-type :value (cast-literal l-value l-type))))
@@ -225,8 +226,8 @@ (cond ((string= literal-type *xml-string*) literal-value) ((string= literal-type *xml-boolean*) - (when (or (string/= literal-value "false") - (string/= literal-value "true")) + (when (and (string/= literal-value "false") + (string/= literal-value "true")) (error (make-condition 'sparql-parser-error :message (format nil "Could not cast from ~a to ~a" @@ -259,10 +260,14 @@ after the closing literal bounding." (declare (String query-string) (SPARQL-Query query-object)) - (let ((delimiters (list "." ";" "}" " " (string #\tab) - (string #\newline)))) + (let ((delimiters-1 (list "." ";" "}" " " (string #\tab) + (string #\newline))) + (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab) + (string #\newline) + (concatenate 'string "." (string #\newline)) + (concatenate 'string "." (string #\tab))))) (cond ((string-starts-with query-string "@") - (let ((end-pos (search-first delimiters + (let ((end-pos (search-first delimiters-1 (subseq query-string 1)))) (unless end-pos (error (make-sparql-parser-condition @@ -272,7 +277,7 @@ :lang (subseq (subseq query-string 1) 0 end-pos) :type nil))) ((string-starts-with query-string "^^") - (let ((end-pos (search-first delimiters (subseq query-string 2)))) + (let ((end-pos (search-first delimiters-2 (subseq query-string 2)))) (unless end-pos (error (make-sparql-parser-condition query-string (original-query query-object) @@ -282,9 +287,10 @@ (final-type (if (get-prefix query-object type-str) (get-prefix query-object type-str) type-str))) - (list :next-query next-query :type final-type :lang nil)))) + (list :next-query (cut-comment next-query) + :type final-type :lang nil)))) (t - (list :next-query query-string :type nil :lang nil))))) + (list :next-query (cut-comment query-string) :type nil :lang nil)))))
(defun separate-literal-value (query-string query-object) @@ -323,7 +329,7 @@ (find-literal-end (subseq query-string (+ current-pos (length delimiter))) delimiter (+ overall-pos current-pos 1)) - (+ overall-pos current-pos 1)) + (+ overall-pos current-pos (length delimiter))) nil)))
@@ -370,8 +376,9 @@ (not (base-value query-object))) (getf result :value) (concatenate-uri (base-value query-object) - (getf result :value))))) - (list :next-query (getf result :next-query) + (getf result :value)))) + (next-query (getf result :next-query))) + (list :next-query next-query :value (list :value result-uri :type 'IRI))))
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Nov 21 16:03:08 2010 @@ -15,7 +15,8 @@ :constants) (:export :run-sparql-tests :sparql-tests - :test-prefix-and-base)) + :test-prefix-and-base + :test-parse-literals))
(in-package :sparql-test) @@ -152,18 +153,82 @@ (TM-SPARQL::variables query-object-3)))))
-;(test test-parse-literal-string-value -; "Tests the helper function parse-literal-string-value." -; (let ((query-1 " "literal-value"@de.") -; (query-2 "true.") -; (query-3 "false}") -; (query-4 "1234.43e10") -; (query-4 (concatenate 'string "'''true'''"^^" *xml-boolean* " ;")) - - - ;TODO: delimiter " ;" or " ." - ;TODO: handle: subject predicate object; predicate object -; ) +(test test-parse-literals + "Tests the helper functions for parsing literals." + (let ((query-1 " "literal-value"@de.") + (query-2 "true.") + (query-3 "false}") + (query-4 (concatenate 'string "1234.43e10" (string #\tab))) + (query-5 (concatenate 'string "'''true'''^^" *xml-boolean* " ;")) + (query-6 (concatenate 'string "'123.4'^^" *xml-double* + "." (string #\newline))) + (query-7 ""Just a test + +literal with some \"quoted\" words!"@en.") + (query-8 (concatenate 'string "'''12.4'''^^" *xml-integer* ". ")) + (query-9 (concatenate 'string ""13e4"^^" *xml-boolean* " .")) + (dummy-object (make-instance 'SPARQL-Query :query ""))) + (is-true dummy-object) + (let ((result (tm-sparql::parse-literal-elem query-1 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (string= (getf (getf result :value) :value) + "literal-value")) + (is (string= (getf (getf result :value) :literal-lang) + "de")) + (is (string= (getf (getf result :value) :literal-type) + *xml-string*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-2 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (eql (getf (getf result :value) :value) t)) + (is-false (getf (getf result :value) :literal-lang)) + (is (string= (getf (getf result :value) :literal-type) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-3 dummy-object))) + (is (string= (getf result :next-query) "}")) + (is (eql (getf (getf result :value) :value) nil)) + (is-false (getf (getf result :value) :literal-lang)) + (is (string= (getf (getf result :value) :literal-type) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-4 dummy-object))) + (is (string= (getf result :next-query) (string #\tab))) + (is (= (getf (getf result :value) :value) 1234.43e10)) + (is-false (getf (getf result :value) :literal-lang)) + (is (string= (getf (getf result :value) :literal-type) + *xml-double*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-5 dummy-object))) + (is (string= (getf result :next-query) ";")) + (is (eql (getf (getf result :value) :value) t)) + (is-false (getf (getf result :value) :literal-lang)) + (is (string= (getf (getf result :value) :literal-type) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-6 dummy-object))) + (is (string= (getf result :next-query) + (concatenate 'string "." (string #\newline)))) + (is (= (getf (getf result :value) :value) 123.4)) + (is-false (getf (getf result :value) :literal-lang)) + (is (string= (getf (getf result :value) :literal-type) + *xml-double*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (let ((result (tm-sparql::parse-literal-elem query-7 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (string= (getf (getf result :value) :value) + "Just a test + +literal with some \"quoted\" words!")) + (is (string= (getf (getf result :value) :literal-lang) + "en")) + (is (string= (getf (getf result :value) :literal-type) + *xml-string*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (signals sparql-parser-error + (tm-sparql::parse-literal-elem query-8 dummy-object)) + (signals sparql-parser-error + (tm-sparql::parse-literal-elem query-9 dummy-object))))
(defun run-sparql-tests ()