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

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Nov 22 14:47:01 2010
New Revision: 347

Log:
TM-SPARQL: added some unit-tests for parsing variables and IRIs in the SELECT-WHERE-statement => fixed some bugs

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	Mon Nov 22 14:47:01 2010
@@ -86,8 +86,8 @@
     (loop for entry in (prefixes construct)
        when (string-starts-with string-with-prefix
 				(concatenate 'string (getf entry :label) ":"))
-       return (concatenate
-	       'string (getf entry :value) ":"
+       return (concatenate-uri
+	       (getf entry :value)
 	       (string-after string-with-prefix
 			     (concatenate 'string (getf entry :label) ":"))))))
 

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Mon Nov 22 14:47:01 2010
@@ -154,7 +154,7 @@
 	  ((or (string-starts-with trimmed-str "?")
 	       (string-starts-with trimmed-str "$"))
 	   (let ((result (parse-variable-name trimmed-str query-object)))
-	     (list :next-query (getf result :next-query)
+	     (list :next-query (cut-comment (getf result :next-query))
 		   :value (list :value (getf result :value)
 				:type 'VAR))))
 	  (t
@@ -378,7 +378,7 @@
 	      (concatenate-uri (base-value query-object)
 			       (getf result :value))))
 	 (next-query (getf result :next-query)))
-    (list :next-query next-query
+    (list :next-query (cut-comment next-query)
 	  :value (list :value result-uri :type 'IRI))))
 
 
@@ -396,15 +396,24 @@
 	 (prefix (when elem-str
 		   (string-until elem-str ":")))
 	 (suffix (when prefix
-		   (string-after elem-str ":"))))
+		   (string-after elem-str ":")))
+	 (full-url
+	  (when (and suffix prefix)
+	    (get-prefix query-object (concatenate 'string prefix ":" suffix)))))
     (unless (and end-pos prefix suffix)
       (error (make-sparql-parser-condition
 	      trimmed-str (original-query query-object)
 	      "An IRI of the form prefix:suffix")))
-    (list :next-query (string-after
-		       trimmed-str
-		       (concatenate 'string prefix ":" suffix))
-	  :value (list :value (concatenate 'string prefix ":" suffix)
+    (unless full-url
+      (error (make-condition
+	      'sparql-parser-error
+	      :message (format nil "The prefix in \"~a:~a\" is not registered"
+			       prefix suffix))))
+    (list :next-query (cut-comment
+		       (string-after
+			trimmed-str
+			(concatenate 'string prefix ":" suffix)))
+	  :value (list :value full-url
 		       :type 'IRI))))
 
 

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Mon Nov 22 14:47:01 2010
@@ -16,7 +16,8 @@
   (:export :run-sparql-tests
 	   :sparql-tests
 	   :test-prefix-and-base
-	   :test-parse-literals))
+	   :test-parse-literals
+	   :test-parse-triple-elem))
 
 
 (in-package :sparql-test)
@@ -231,5 +232,49 @@
       (tm-sparql::parse-literal-elem query-9 dummy-object))))
 
 
+(test test-parse-triple-elem
+  "Tests various functionality of the parse-triple-elem function."
+  (let ((query-1 "?var1   .")
+	(query-2 "$var2 ;")
+	(query-3 "$var3 }")
+	(query-4 "<http://full.url>.")
+	(query-5 "<url-suffix>  }")
+	(query-6 "pref:suffix  .")
+	(query-7 "pref:suffix}")
+	(query-8 "preff:suffix}")
+	(dummy-object (make-instance 'SPARQL-Query :query ""
+				     :base "http://base.value")))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (signals sparql-parser-error 
+      (tm-sparql::parse-triple-elem query-8 dummy-object))))
+
 (defun run-sparql-tests ()
-  (it.bese.fiveam:run! 'sparql-test:sparql-tests))
\ No newline at end of file
+  (it.bese.fiveam:run! 'sparql-test:sparql-tests))