Author: lgiessmann Date: Tue Nov 23 15:10:48 2010 New Revision: 350
Log: TM-SPARQL: fixed a bug with BASE within the select-where statement; extended the object-model of the sparql-interface; adapted all unit-tests of the sparql-interface
Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/model/exceptions.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 15:10:48 2010 @@ -17,9 +17,60 @@ (defvar *empty-label* "_empty_label_symbol")
-;(defclass SPARQL-Triple () -; (()) -; ) +(defclass SPARQL-Triple-Elem() + ((elem-type :initarg :elem-type + :reader elem-type + :type Symbol + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple-Elem(): elem-type must be set")) + :documentation "Contains information about the type of this element + possible values are 'IRI, 'VARIABLE, or 'LITERAL") + (value :initarg :value + :accessor value + :type T + :initform nil + :documentation "Contains the actual value of any type.") + (literal-lang :initarg :literal-lang + :accessor literal-lang + :initform nil + :type String + :documentation "Contains the @lang attribute of a literal") + (literal-type :initarg :literal-type + :accessor literal-type + :type String + :initform nil + :documentation "Contains the datatype of the literal, e.g. xml:string")) + (:documentation "Represents one element of an RDF-triple.")) + + +(defclass SPARQL-Triple() + ((subject :initarg :subject + :accessor subject + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple(): subject must be set")) + :documentation "Represents the subject of an RDF-triple.") + (predicate :initarg :predicate + :accessor predicate + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple(): predicate must be set")) + :documentation "Represents the predicate of an RDF-triple.") + (object :initarg :object + :accessor object + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple-(): object must be set")) + :documentation "Represents the subject of an RDF-triple.")) + (:documentation "Represents an entire RDF-triple."))
(defclass SPARQL-Query () @@ -53,17 +104,36 @@ :type String :initform nil :documentation "Contains the last set base-value.") - (select-statements :initarg :select-statements - :accessor select-statements ;this value is only for - ;internal purposes purposes - ;and mustn't be reset - :type List - :initform nil - :documentation "A list of the form ((:statement 'statement' - :value value-object))")) + (select-group :initarg :select-group + :accessor select-group ;this value is only for + ;internal purposes purposes + ;and mustn't be reset + :type List + :initform nil + :documentation "Contains a SPARQL-Group that represents + the entire inner select-where statement.")) (:documentation "This class represents the entire request."))
+(defgeneric add-triple (construct triple) + (:documentation "Adds a triple object to the select-group list.") + (:method ((construct SPARQL-Query) (triple SPARQL-Triple)) + (push triple (slot-value construct 'select-group)))) + + +(defgeneric (setf elem-type) (construct elem-type) + (:documentation "Sets the passed elem-type on the passed cosntruct.") + (:method ((construct SPARQL-Triple-Elem) (elem-type Symbol)) + (unless (and (eql elem-type 'IRI) + (eql elem-type 'VARIABLE) + (eql elem-type 'LITERAL)) + (error (make-condition + 'bad-argument-error + :message (format nil "Expected a one of the symbols ~a, but get ~a~%" + '('IRI 'VARIABLE 'LITERAL) elem-type)))) + (setf (slot-value construct 'elem-type) elem-type))) + + (defgeneric add-prefix (construct prefix-label prefix-value) (:documentation "Adds the new prefix tuple to the list of all existing. If there already exists a tuple with the same label
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 15:10:48 2010 @@ -109,21 +109,23 @@ query-tail))))
-(defgeneric parse-group (construct query-string &key last-subject values filters) +(defgeneric parse-group (construct query-string &key last-subject) (:documentation "The entry-point for the parsing of a {} statement.") (:method ((construct SPARQL-Query) (query-string String) - &key (last-subject nil) (values nil) (filters nil)) - (declare (List last-subject values filters)) + &key (last-subject nil)) + (declare (type (or Null SPARQL-Triple-Elem) last-subject)) (let ((trimmed-str (cut-comment query-string))) (cond ((string-starts-with trimmed-str "BASE") (parse-base construct (string-after trimmed-str "BASE") - #'parse-where)) + #'(lambda(constr query-str) + (parse-group constr query-str + :last-subject last-subject)))) ((string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: parse-filter and store it + nil) ;TODO: parse-filter and store it in construct => extend class ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -133,12 +135,10 @@ trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "}") ;ending of this group - ;TODO: invoke filters with all results + ;TODO: invoke filters with all results on construct in initialize :after (subseq trimmed-str 1)) (t - ;(let ((result - (parse-triple construct trimmed-str :values values - :filters filters :last-subject last-subject)))))) + (parse-triple construct trimmed-str :last-subject last-subject))))))
(defun parse-filter (query-string query-object) @@ -152,9 +152,7 @@
(defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) - "A helper function to parse a subject or predicate of an RDF triple. - Returns an entry of the form (:value (:value string :type <'VAR|'IRI|'LITERAL>) - :next-query string)." + "A helper function to parse a subject or predicate of an RDF triple." (declare (String query-string) (SPARQL-Query query-object) (Boolean literal-allowed)) @@ -165,8 +163,9 @@ (string-starts-with trimmed-str "$")) (let ((result (parse-variable-name trimmed-str query-object))) (list :next-query (cut-comment (getf result :next-query)) - :value (list :value (getf result :value) - :type 'VAR)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'VARIABLE + :value (getf result :value))))) (t (if (or (string-starts-with-digit trimmed-str) (string-starts-with trimmed-str """) @@ -202,10 +201,11 @@ ((string-starts-with-digit trimmed-str) (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 :type) - :type 'LITERAL - :literal-lang (getf value-type-lang-query :lang))))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'LITERAL + :value (getf value-type-lang-query :value) + :literal-lang (getf value-type-lang-query :lang) + :literal-type (getf value-type-lang-query :type)))))
(defun parse-literal-string-value (query-string query-object) @@ -389,7 +389,9 @@ (getf result :value)))) (next-query (getf result :next-query))) (list :next-query (cut-comment next-query) - :value (list :value result-uri :type 'IRI)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value result-uri))))
(defun parse-prefix-suffix-pair(query-string query-object) @@ -423,20 +425,15 @@ (string-after trimmed-str (concatenate 'string prefix ":" suffix))) - :value (list :value full-url - :type 'IRI)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value full-url))))
-(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) - &key (last-subject nil) (values nil) (filters nil)) - (declare (List last-subject filters values)) +(defgeneric parse-triple (construct query-string &key last-subject) + (:documentation "Parses a triple within a trippel group.") + (:method ((construct SPARQL-Query) (query-string String) &key (last-subject nil)) + (declare (type (or Null SPARQL-Triple-Elem) last-subject)) (let* ((trimmed-str (cut-comment query-string)) (subject-result (if last-subject ;;is used after a ";" last-subject @@ -444,28 +441,27 @@ (predicate-result (parse-triple-elem (if last-subject trimmed-str - (getf subject-result :next-query)) + (if last-subject + trimmed-str + (getf subject-result :next-query))) construct)) (object-result (parse-triple-elem (getf predicate-result :next-query) - construct :literal-allowed t)) - (all-values (append values - (list - (list :subject (getf subject-result :value) - :predicate (getf predicate-result :value) - :object (getf object-result :value)))))) + construct :literal-allowed t))) + (add-triple construct + (make-instance 'SPARQL-Triple + :subject (if last-subject + last-subject + (getf subject-result :value)) + :predicate (getf predicate-result :value) + :object (getf object-result :value))) (let ((tr-str (cut-comment (getf object-result :next-query)))) (cond ((string-starts-with tr-str ";") - (parse-group - construct (subseq tr-str 1) - :last-subject (list :value (getf subject-result :value)) - :values all-values - :filters filters)) + (parse-group construct (subseq tr-str 1) + :last-subject (getf subject-result :value))) ((string-starts-with tr-str ".") - (parse-group construct (subseq tr-str 1) :values all-values - :filters filters)) + (parse-group construct (subseq tr-str 1))) ((string-starts-with tr-str "}") - (parse-group construct tr-str :values all-values - :filters filters))))))) + (parse-group construct tr-str)))))))
(defgeneric parse-variables (construct query-string)
Modified: trunk/src/model/exceptions.lisp ============================================================================== --- trunk/src/model/exceptions.lisp (original) +++ trunk/src/model/exceptions.lisp Tue Nov 23 15:10:48 2010 @@ -18,11 +18,18 @@ :missing-argument-error :tm-reference-error :bad-type-error - :sparql-parser-error)) + :sparql-parser-error + :bad-argument-error))
(in-package :exceptions)
+(define-condition bad-argument-error(error) + ((message + :initarg :message + :accessor message))) + + (define-condition sparql-parser-error(error) ((message :initarg :message
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 15:10:48 2010 @@ -174,60 +174,59 @@ (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) + (is (string= (tm-sparql::value (getf result :value)) "literal-value")) - (is (string= (getf (getf result :value) :literal-lang) + (is (string= (tm-sparql::literal-lang (getf result :value)) "de")) - (is (string= (getf (getf result :value) :literal-type) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-string*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (eql (tm-sparql::value (getf result :value)) t)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (eql (tm-sparql::value (getf result :value)) nil)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (= (tm-sparql::value (getf result :value)) 1234.43e10)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-double*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (eql (tm-sparql::value (getf result :value)) t)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (eql (tm-sparql::value (getf result :value)) 123.4)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-double*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) '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) + (is (string= (tm-sparql::value (getf result :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) + (is (string= (tm-sparql::literal-lang (getf result :value)) "en")) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-string*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (signals sparql-parser-error (tm-sparql::parse-literal-elem query-8 dummy-object)) (signals sparql-parser-error @@ -245,36 +244,42 @@ (query-7 "pref:suffix}") (query-8 "preff:suffix}") (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value"))) + :base "http://base.value")) + (var 'TM-SPARQL::VARIABLE) + (iri 'TM-SPARQL::IRI)) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value") (let ((result (tm-sparql::parse-triple-elem query-1 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "var1")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var1")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-2 dummy-object))) (is (string= (getf result :next-query) ";")) - (is (string= (getf (getf result :value) :value) "var2")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var2")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-3 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "var3")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var3")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-4 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "http://full.url")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://full.url")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-5 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "http://base.value/url-suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://base.value/url-suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-6 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://prefix.value/suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-7 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://prefix.value/suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (signals sparql-parser-error (tm-sparql::parse-triple-elem query-8 dummy-object))))
@@ -286,141 +291,121 @@ (query-2 "<subject> pref:predicate 1234.5e12}") (query-3 "pref:subject ?predicate 'literal'@en}") (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value/"))) + :base "http://base.value/")) + (var 'TM-SPARQL::VARIABLE) + (lit 'TM-SPARQL::LITERAL) + (iri 'TM-SPARQL::IRI)) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (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) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) - "subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) - "predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :object) :value) - "object"))) - (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)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (string= (tm-sparql::parse-triple dummy-object query-1) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 1)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "subject")) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "predicate")) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "object"))) + (is (string= (tm-sparql::parse-triple dummy-object query-2) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 2)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://prefix.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (= (getf (getf (first (getf result :values)) :object) :value) - 1234.5e12)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) - *xml-double*))) - (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)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (= (tm-sparql::value (tm-sparql::object elem)) 1234.5e12)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-double*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (is (string= (tm-sparql::parse-triple dummy-object query-3) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 3)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://prefix.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (string= (getf (getf (first (getf result :values)) :object) :value) - "literal")) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-lang) - "en"))))) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "literal")) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-string*)) + (is (string= (tm-sparql::literal-lang (tm-sparql::object elem)) "en")))))
-(test test-parse-triple-2 +(test test-parse-group-2 "Test various functionality of several functions responsible for parsing the SELECT-WHERE-statement." (let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^" *xml-boolean* "; pref:predicate-2 "12"^^" *xml-integer* "}")) (query-5 (concatenate 'string "<subject> <predicate> '''false'''^^" - *xml-boolean* "; pref:predicate-2 "abc"^^" + *xml-boolean* "; BASE http://new.base/" + "<predicate-2> "abc"^^" *xml-string* "}")) (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value/"))) + :base "http://base.value/")) + (lit 'TM-SPARQL::LITERAL) + (iri 'TM-SPARQL::IRI)) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (let ((result (tm-sparql::parse-triple dummy-object query-4 nil))) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (string= (tm-sparql::parse-group dummy-object query-4) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 2)) + (let ((elem (second (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://base.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (eql (getf (getf (first (getf result :values)) :object) :value) t)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (eql (tm-sparql::value (tm-sparql::object elem)) t)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) *xml-boolean*)) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (second (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :subject) :value) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (second (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://prefix.value/predicate-2")) - (is (eql (getf (getf (second (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (= (getf (getf (second (getf result :values)) :object) :value) 12)) - (is (string= (getf (getf (second (getf result :values)) :object) - :literal-type) - *xml-integer*))) - (let ((result (tm-sparql::parse-triple dummy-object query-5 nil))) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (= (tm-sparql::value (tm-sparql::object elem)) 12)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-integer*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (is (string= "http://base.value/" (tm-sparql::base-value dummy-object))) + (is (string= (tm-sparql::parse-group dummy-object query-5) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 4)) + (is (string= "http://new.base/" (tm-sparql::base-value dummy-object))) + (let ((elem (second (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://base.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (eql (getf (getf (first (getf result :values)) :object) :value) nil)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (eql (tm-sparql::value (tm-sparql::object elem)) nil)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) *xml-boolean*)) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (second (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :subject) :value) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (second (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :predicate) :value) - "http://prefix.value/predicate-2")) - (is (eql (getf (getf (second (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (string= (getf (getf (second (getf result :values)) :object) :value) - "abc")) - (is (string= (getf (getf (second (getf result :values)) :object) - :literal-type) - *xml-string*))))) - + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) + "http://new.base/predicate-2")) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "abc")) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-string*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))))
(defun run-sparql-tests ()