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

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Nov 18 15:04:16 2010
New Revision: 341

Log:
fixed several bugs in the processing of PREFIX-statements

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	Thu Nov 18 15:04:16 2010
@@ -18,7 +18,7 @@
 
 
 (defclass SPARQL-Query ()
-  ((original-query :initarg :original-query
+  ((original-query :initarg :query
 		   :reader original-query
 		   :type String
 		   :initform (error
@@ -29,6 +29,7 @@
    (prefix-list :initarg :prefix-list
 		:reader prefix-list
 		:type List
+		:initform nil
 		:documentation "A list of the form
                                ((:label 'id' :value 'prefix'))")
    (variables :initarg :variables
@@ -48,10 +49,10 @@
   (:documentation "Adds the new prefix tuple to the list of all existing.
                    If there already exists a tuple with the same label
                    the label's value will be overwritten by the new value.")
-  (:method ((construct SPARQL-Query) (prefix-label Symbol) (prefix-value String))
+  (:method ((construct SPARQL-Query) (prefix-label String) (prefix-value String))
     (let ((existing-tuple
 	   (find-if #'(lambda(x)
-			(eql (getf x :label) prefix-label))
+			(string= (getf x :label) prefix-label))
 		    (prefix-list construct))))
       (if existing-tuple
 	  (setf (getf existing-tuple :value) prefix-value)
@@ -62,5 +63,5 @@
 
 (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args)
   (declare (ignorable args))
-  (parser-start construct)
+  (parser-start construct (original-query construct))
   construct)

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Thu Nov 18 15:04:16 2010
@@ -26,10 +26,10 @@
   (:method ((construct SPARQL-Query) (query-string String))
     (let ((trimmed-query-string (trim-whitespace-left query-string)))
       (cond ((string-starts-with trimmed-query-string "SELECT")
-	     (parse-prefixes construct
-			     (string-after trimmed-query-string "SELECT")))
+	     nil) ;;TODO: implement
 	    ((string-starts-with trimmed-query-string "PREFIX")
-	     nil) ;TODO: implement
+	     (parse-prefixes construct
+			     (string-after trimmed-query-string "PREFIX")))
 	    ((string-starts-with trimmed-query-string "BASE")
 	     nil) ;TODO: implement
 	    (t
@@ -52,6 +52,9 @@
 		 (next-query-str
 		  (trim-whitespace-left (string-after trimmed-string ":")))
 		 (results (parse-bracket-value next-query-str construct)))
+	    (when (string= label-name trimmed-string)
+	      (error (make-sparql-parser-condition
+		      trimmed-string (original-query construct) ":")))
 	    (add-prefix construct label-name (getf results :value))
 	    (parser-start construct (getf results :query-string)))))))
 
@@ -63,12 +66,9 @@
   (declare (String query-string open close)
 	   (SPARQL-Query query-object))
   (let ((trimmed-string (trim-whitespace-left query-string)))
-    (if (and (string-starts-with trimmed-string open)
-	     (> (length (string-after trimmed-string close)) 0))
-	(let* ((pref-url
-		(string-until (string-after trimmed-string open) close))
-	       (next-query-str
-		(string-after pref-url close)))
+    (if (string-starts-with trimmed-string open)
+	(let* ((pref-url (string-until (string-after trimmed-string open) close))
+	       (next-query-str (string-after trimmed-string close)))
 	  (unless next-query-str
 	    (error (make-sparql-parser-condition
 		    trimmed-string (original-query query-object)
@@ -77,7 +77,7 @@
 		:value pref-url))
 	(error (make-sparql-parser-condition
 		trimmed-string (original-query query-object)
-		open)))))
+		close)))))
 
 
 

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Thu Nov 18 15:04:16 2010
@@ -24,5 +24,13 @@
 (in-suite sparql-test)
 
 
+;TODO: prefix tests
+;PREFIX foaf  :   <http://xmlns.com/foaf/0.1/>
+;PREFIX org:    <http://example.com/ns#>
+;PREFIX isi:<http://isidor.us>
+;PREFIX :<http://some.where>
+;PREFIX foaf : <http://overwrite.foaf>"
+
+
 (defun run-sparql-tests ()
   (it.bese.fiveam:run! 'sparql-test:sparql-tests))
\ No newline at end of file