[isidorus-cvs] r349 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Nov 23 16:45:58 UTC 2010
Author: lgiessmann
Date: Tue Nov 23 11:45:57 2010
New Revision: 349
Log:
TM-SPARQL: fixed a recursion bug when parsing SELECT-WHERE-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 Tue Nov 23 11:45:57 2010
@@ -16,20 +16,13 @@
(defvar *empty-label* "_empty_label_symbol")
-(defclass Variable-Container ()
- ((variables :initarg :variables
- :accessor variables ;this value is only for internal purposes
- ;purposes and mustn't be reset
- :type List
- :initform nil
- :documentation "A list of the form ((:variable var-name
- :value value-object)), that contains tuples
- for each variable and its result."))
- (:documentation "This class is used to store all variable in a WHERE{}
- statement"))
+
+;(defclass SPARQL-Triple ()
+; (())
+; )
-(defclass SPARQL-Query (Variable-Container)
+(defclass SPARQL-Query ()
((original-query :initarg :query
:accessor original-query ;this value is only for internal
;purposes and mustn't be reset
@@ -39,6 +32,14 @@
'missing-argument-error
:message "From TM-Query(): original-query must be set"))
:documentation "Containst the original received querry as string")
+ (variables :initarg :variables
+ :accessor variables ;this value is only for internal purposes
+ ;purposes and mustn't be reset
+ :type List
+ :initform nil
+ :documentation "A list of the form ((:variable var-name
+ :value value-object)), that contains tuples
+ for each selected variable and its result.")
(prefixes :initarg :prefixes
:accessor prefixes ;this value is only for internal purposes
;purposes and mustn't be reset
@@ -97,7 +98,7 @@
If a variable-already exists the existing entry will be
overwritten. An entry is of the form
(:variable string :value any-type).")
- (:method ((construct Variable-Container) (variable-name String) variable-value)
+ (:method ((construct SPARQL-Query) (variable-name String) variable-value)
(let ((existing-tuple
(find-if #'(lambda(x)
(string= (getf x :variable) variable-name))
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Nov 23 11:45:57 2010
@@ -104,15 +104,16 @@
(unless (string-starts-with trimmed-str "{")
(error (make-sparql-parser-condition trimmed-str
(original-query construct) "{")))
- (let ((query-tail (parse-group construct (subseq trimmed-str 1) nil nil)))
+ (let ((query-tail (parse-group construct (subseq trimmed-str 1))))
;TODO: process query-tail
query-tail))))
-(defgeneric parse-group (construct query-string values filters)
+(defgeneric parse-group (construct query-string &key last-subject values filters)
(:documentation "The entry-point for the parsing of a {} statement.")
(:method ((construct SPARQL-Query) (query-string String)
- (values List) (filters List))
+ &key (last-subject nil) (values nil) (filters nil))
+ (declare (List last-subject values filters))
(let ((trimmed-str (cut-comment query-string)))
(cond ((string-starts-with trimmed-str "BASE")
(parse-base construct (string-after trimmed-str "BASE")
@@ -122,7 +123,7 @@
trimmed-str (original-query construct)
"FILTER, BASE, or triple. Grouping is currently no implemented.")))
((string-starts-with trimmed-str "FILTER")
- nil) ;TODO: call parse-group with added filter
+ nil) ;TODO: parse-filter and store it
((string-starts-with trimmed-str "OPTIONAL")
(error (make-sparql-parser-condition
trimmed-str (original-query construct)
@@ -135,10 +136,19 @@
;TODO: invoke filters with all results
(subseq trimmed-str 1))
(t
- (let ((result (parse-triple construct trimmed-str values)))
- (parse-group construct (getf result :next-query)
- (getf result :values) filters)))))))
-
+ ;(let ((result
+ (parse-triple construct trimmed-str :values values
+ :filters filters :last-subject last-subject))))))
+
+
+(defun parse-filter (query-string query-object)
+ "A helper functions that returns a filter and the next-query string
+ in the form (:next-query string :filter object)."
+ ;; !, +, -, *, /, (, ), &&, ||, =, !=, <, >, >=, <=, REGEX(string, pattern)
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ ;;TODO: implement
+ (or query-string query-object))
(defun parse-triple-elem (query-string query-object &key (literal-allowed nil))
@@ -417,15 +427,16 @@
:type 'IRI))))
-(defgeneric parse-triple (construct query-string values &key last-subject)
+(defgeneric parse-triple (construct query-string
+ &key last-subject values filters)
(:documentation "Parses a triple within a trippel group and returns a
a list of the form (:next-query :values (:subject
(:type <'VAR|'IRI> :value string) :predicate
(:type <'VAR|'IRI> :value string)
:object (:type <'VAR|'IRI|'LITERAL> :value string))).")
- (:method ((construct SPARQL-Query) (query-string String) (values List)
- &key (last-subject nil))
- (declare (List last-subject))
+ (:method ((construct SPARQL-Query) (query-string String)
+ &key (last-subject nil) (values nil) (filters nil))
+ (declare (List last-subject filters values))
(let* ((trimmed-str (cut-comment query-string))
(subject-result (if last-subject ;;is used after a ";"
last-subject
@@ -444,14 +455,17 @@
:object (getf object-result :value))))))
(let ((tr-str (cut-comment (getf object-result :next-query))))
(cond ((string-starts-with tr-str ";")
- (parse-triple construct (subseq tr-str 1) all-values
- :last-subject (list :value
- (getf subject-result :value))))
+ (parse-group
+ construct (subseq tr-str 1)
+ :last-subject (list :value (getf subject-result :value))
+ :values all-values
+ :filters filters))
((string-starts-with tr-str ".")
- (parse-triple construct (subseq tr-str 1) all-values))
- ((string-starts-with tr-str "}") ;no other triples follows
- (list :next-query tr-str
- :values all-values)))))))
+ (parse-group construct (subseq tr-str 1) :values all-values
+ :filters filters))
+ ((string-starts-with tr-str "}")
+ (parse-group construct tr-str :values all-values
+ :filters filters)))))))
(defgeneric parse-variables (construct query-string)
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Tue Nov 23 11:45:57 2010
@@ -17,7 +17,9 @@
:sparql-tests
:test-prefix-and-base
:test-parse-literals
- :test-parse-triple-elem))
+ :test-parse-triple-elem
+ :test-parse-group-1
+ :test-parse-group-2))
(in-package :sparql-test)
@@ -287,7 +289,7 @@
:base "http://base.value/")))
(is-true dummy-object)
(tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/")
- (let ((result (tm-sparql::parse-triple dummy-object query-1 nil)))
+ (let ((result (tm-sparql::parse-triple dummy-object query-1)))
(is (string= (getf result :next-query) "}"))
(is (= (length (getf result :values)) 1))
(is (eql (getf (getf (first (getf result :values)) :subject) :type)
@@ -302,7 +304,7 @@
'TM-SPARQL::VAR))
(is (string= (getf (getf (first (getf result :values)) :object) :value)
"object")))
- (let ((result (tm-sparql::parse-triple dummy-object query-2 nil)))
+ (let ((result (tm-sparql::parse-triple dummy-object query-2)))
(is (string= (getf result :next-query) "}"))
(is (eql (getf (getf (first (getf result :values)) :subject) :type)
'TM-SPARQL::IRI))
@@ -319,7 +321,7 @@
(is (string= (getf (getf (first (getf result :values)) :object)
:literal-type)
*xml-double*)))
- (let ((result (tm-sparql::parse-triple dummy-object query-3 nil)))
+ (let ((result (tm-sparql::parse-triple dummy-object query-3)))
(is (string= (getf result :next-query) "}"))
(is (eql (getf (getf (first (getf result :values)) :subject) :type)
'TM-SPARQL::IRI))
@@ -338,7 +340,7 @@
"en")))))
-(test test-parse-group-2
+(test test-parse-triple-2
"Test various functionality of several functions responsible for parsing
the SELECT-WHERE-statement."
(let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^"
More information about the Isidorus-cvs
mailing list