[isidorus-cvs] r346 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sun Nov 21 21:03:08 UTC 2010
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 ()
More information about the Isidorus-cvs
mailing list