Author: lgiessmann Date: Fri Apr 1 06:04:00 2011 New Revision: 398 Log: TM-SPARQL: finished unit-tests for the special predicates rdf:type, a, and tmdm:type => fixed a problem with rdf:type 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 Fri Apr 1 06:04:00 2011 @@ -144,7 +144,14 @@ :elem-type 'IRI :value *type-psi*))) ((string-starts-with trimmed-str "<") - (parse-base-suffix-pair construct trimmed-str)) + (let ((result (parse-base-suffix-pair construct trimmed-str))) + (if (and (not (variable-p (getf result :value))) + (string= (value (getf result :value)) *rdf-type*)) + (list :next-query (getf result :next-query) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value *type-psi*)) + result))) ((or (string-starts-with trimmed-str "?") (string-starts-with trimmed-str "$")) (let ((result @@ -166,8 +173,14 @@ trimmed-str (original-query construct) "an IRI of the form prefix:suffix or <iri> but found a literal."))) (parse-literal-elem construct trimmed-str)) - (parse-prefix-suffix-pair construct trimmed-str))))))) - + (let ((result (parse-prefix-suffix-pair construct trimmed-str))) + (if (and (not (variable-p (getf result :value))) + (string= (value (getf result :value)) *rdf-type*)) + (list :next-query (getf result :next-query) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value *type-psi*)) + result)))))))) (defgeneric parse-literal-elem (construct query-string) (:documentation "A helper-function that returns a literal vaue of the form @@ -338,7 +351,7 @@ (:method ((construct SPARQL-Query) (query-string String)) (let* ((trimmed-str (cut-comment query-string)) (delimiters (list "." ";" "}" "<" " " (string #\newline) - (string #\tab) "#")) + (string #\tab))) ; "#")) (end-pos (search-first delimiters trimmed-str)) (elem-str (when end-pos (subseq trimmed-str 0 end-pos))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Fri Apr 1 06:04:00 2011 @@ -1635,7 +1635,7 @@ "SELECT * WHERE { ?subj1 <http://some.where/tmsparql/first-name> \"Johann Wolfgang\". ?subj2 <http://some.where/tmsparql/last-name> 'von Goethe'^^" - *xml-string* ". + *xml-string* ". ?subj3 <http://some.where/tmsparql/date-of-birth> '28.08.1749'^^" *xml-date* ". ?subj4 <http://some.where/tmsparql/date-of-death> '22.03.1832'^^" @@ -1683,5 +1683,31 @@ (is-true (d:get-item-by-psi *rdf-type* :revision 0)))) +(test test-all-2 + "Tests the entire module with the file sparql_test.xtm" + (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*) + (tm-sparql:init-tm-sparql) + (let* ((q-1 (concat + "PREFIX pref:<http://www.w3.org/1999/02/> + SELECT * WHERE { + ?subj1 a <http://some.where/tmsparql/author> . + ?subj2 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> <http://some.where/tmsparql/author> . + ?subj3 <http://psi.topicmaps.org/iso13250/model/type> <http://some.where/tmsparql/author> . + ?subj4 pref:22-rdf-syntax-ns#type <http://some.where/tmsparql/author>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 4)) + (map 'list #'(lambda(item) + (cond ((or (string= (getf item :variable) "subj1") + (string= (getf item :variable) "subj2") + (string= (getf item :variable) "subj3") + (string= (getf item :variable) "subj4")) + (is (string= (first (getf item :result)) + "<http://some.where/tmsparql/author/goethe>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))