[isidorus-cvs] r398 - in trunk/src: TM-SPARQL unit_tests

[Lukas Giessmann]

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))