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

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Apr  8 04:49:14 2011
New Revision: 426

Log:
TM-SPARQL: finished the implementation of the SPARQL-API; finished the unit-tests of the SPARQL-API

Modified:
   trunk/src/TM-SPARQL/filter_wrappers.lisp
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/unit_tests/sparql_test.lisp

Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp
==============================================================================
--- trunk/src/TM-SPARQL/filter_wrappers.lisp	(original)
+++ trunk/src/TM-SPARQL/filter_wrappers.lisp	Fri Apr  8 04:49:14 2011
@@ -10,7 +10,7 @@
 
 (defpackage :filter-functions
   (:use :base-tools :constants :tm-sparql)
-  (:import-from :cl progn handler-case let))
+  (:import-from :cl progn handler-case let condition))
 
 
 (defun filter-functions::normalize-value (value)
@@ -149,7 +149,8 @@
 				:case-insensitive-mode case-insensitive
 				:multi-line-mode multi-line
 				:single-line-mode single-line)))
-    (ppcre:scan scanner local-str)))
+    (when (ppcre:scan scanner local-str)
+      t)))
 
 
 (defun filter-functions::write-to-symbol (name-string)
@@ -187,11 +188,4 @@
 
 
 (defun filter-functions::str(x)
-  ;(if (stringp x) ;TODO: remove
-  ;(if (and (base-tools:string-starts-with x "<")
-  ;(base-tools:string-ends-with x ">")
-  ;(base-tools:absolute-uri-p (subseq x 1 (1- (length x)))))
-  ;(subseq x 1 (1- (length x)))
-  ;x)
-  ;(write-to-string x)))
-  (write-to-string x))
\ No newline at end of file
+   (write-to-string x))
\ No newline at end of file

Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql.lisp	Fri Apr  8 04:49:14 2011
@@ -511,13 +511,13 @@
 	  (variable-p
 	   (cond ((eql what :subject)
 		  (and (variable-p (subject construct))
-		       (value (subject construct))))
+		       (string= (value (subject construct)) variable-name)))
 		 ((eql what :predicate)
 		  (and (variable-p (predicate construct))
-		       (value (predicate construct))))
+		       (string=  (value (predicate construct)) variable-name)))
 		 ((eql what :object)
 		  (and (variable-p (object construct))
-		       (value (object construct)))))))
+		       (string= (value (object construct)) variable-name))))))
       (when variable-p
 	(remove-null
 	 (dotimes (idx (length local-results))

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  8 04:49:14 2011
@@ -2403,18 +2403,45 @@
   (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
     (tm-sparql:init-tm-sparql)
     (let* ((q-1 (concat
-		 "SELECT * WHERE {
+		 "SELECT ?pred1 ?obj3 ?obj1 WHERE {
                    <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
                    FILTER isLITERAL(?obj1) && !isLITERAL(?pred1) && ?obj1 = 'von Goethe' || ?obj1 = 82
                    FILTER ?pred1 = $pred1 && $obj1 = $obj1 && ?pred1 != ?obj1
 		   FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe'
                    FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1)
 		   FILTER (DATATYPE(?obj1) = '" *xml-string* "' || DATATYPE(?obj1) = '" *xml-integer* "') && !(DATATYPE(?obj1) = '" *xml-double* "')
-                   FILTER STR(?obj1) = '82' || ?obj1='von Goethe'"
+                   FILTER STR(?obj1) = '82' || ?obj1='von Goethe'
+                   FILTER ?obj1 = 82 || REGEX(STR(?obj1), 'von G.*')
+                   ?subj3 <" *tms-value* "> ?obj3.
+                   FILTER REGEX(?obj3, 'e.+e.+')"
 		 "}"))
 	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
-      ;(is-true (= (length r-1) 2))
-      (format t "~a~%" r-1))))
+      (is-true (= (length r-1) 3))
+      (map 'list #'(lambda(item)
+		     (cond
+		       ((string= (getf item :variable) "pred1")
+			(is (= (length (getf item :result)) 2))
+			(is (find "<http://some.where/tmsparql/last-name>"
+				  (getf item :result) :test #'string=))
+			(is (find "<http://some.where/tmsparql/years>"
+				  (getf item :result) :test #'string=)))
+		       ((string= (getf item :variable) "obj1")
+			(is (= (length (getf item :result)) 2))
+			(is (find 82 (getf item :result) :test #'tm-sparql::literal=))
+			(is (find "von Goethe" (getf item :result)
+				  :test #'tm-sparql::literal=)))
+		       ((string= (getf item :variable) "obj3")
+			(is (= (length (getf item :result)) 2))
+			(is-true (find "Der Zauberlehrling" (getf item :result)
+				  :test #'string=))
+			(is-true (find "Hat der alte Hexenmeister
+	sich doch einmal wegbegeben!
+	..." (getf item :result) :test #'string=)))
+		       (t
+			(is-true (format t "bad variable-name found ~a"
+					 (getf item :variable))))))
+	   
+	   r-1))))