[isidorus-cvs] r350 - in trunk/src: TM-SPARQL model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Nov 23 20:10:49 UTC 2010
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 ()
More information about the Isidorus-cvs
mailing list