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

Lukas Giessmann lgiessmann at common-lisp.net
Wed Apr 6 16:14:13 UTC 2011


Author: lgiessmann
Date: Wed Apr  6 12:14:13 2011
New Revision: 421

Log:
TM-SPARQL: fixed an bug that influences the efficiency of the system, i.e. when there are more than one filter the system is getting slow

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_filter.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	Wed Apr  6 12:14:13 2011
@@ -417,29 +417,26 @@
     (dolist (filter (filters construct))
       (let* ((filter-variable-names
 	      (get-variables-from-filter-string filter))
-	     (filter-variable-values nil)
-	     (true-values nil))
+	     (filter-variable-values nil))
 	(dolist (var-name filter-variable-names)
 	  (setf filter-variable-values
 		(make-variable-values construct var-name filter-variable-values)))
 	(setf filter-variable-values
 	      (cast-variable-values construct filter-variable-values))
 	(dolist (filter (filters construct))
-	  (dolist (var-elem filter-variable-values)
-	    
-	    ;(format t "~%~%>>~a<<~%~%" (to-lisp-code var-elem filter)); TODO: remove
-
-	    (when (eval (read-from-string (to-lisp-code var-elem filter)))
-	      (map 'list #'(lambda(list-elem)
-			     (push list-elem true-values))
-		   var-elem))))
-	(let ((values-to-remove
-	       (return-false-values filter-variable-values
-				    (remove-duplicates true-values
-						       :test #'variable-list=))))
-	  (dolist (to-del values-to-remove)
-	    (delete-rows-by-value construct (getf to-del :variable-name)
-				  (getf to-del :variable-value))))))
+	  (let ((true-values nil))
+	    (dolist (var-elem filter-variable-values)
+	      (when (eval (read-from-string (to-lisp-code var-elem filter)))
+		(map 'list #'(lambda(list-elem)
+			       (push list-elem true-values))
+		     var-elem)))
+	    (let ((values-to-remove
+		   (return-false-values filter-variable-values
+					(remove-duplicates true-values
+							   :test #'variable-list=))))
+	      (dolist (to-del values-to-remove)
+		(delete-rows-by-value construct (getf to-del :variable-name)
+				      (getf to-del :variable-value))))))))
     construct))
 
 

Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp	Wed Apr  6 12:14:13 2011
@@ -39,7 +39,7 @@
 
 
 (defparameter *allowed-filter-calls*
-  (append (list "one+" "one-" "progn" "or" "and" "not" "/=" "="
+  (append (list "one+" "one-" "progn" "or" "and" "not" "!=" "="
 		">" ">=" "<" "<=" "+" "-" "*" "/")
 	  *supported-functions*))
 

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Wed Apr  6 12:14:13 2011
@@ -54,7 +54,8 @@
 	   :test-module-13
 	   :test-module-14
 	   :test-module-15
-	   :test-module-16))
+	   :test-module-16
+	   :test-module-17))
 
 
 (in-package :sparql-test)
@@ -2397,10 +2398,21 @@
 	   r-1))))
 
 
+(test test-module-17
+  "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
+		 "SELECT * 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"
+		 "}"))
+	   (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))))
 
 
 
-;TODO: test complex filters
-
 (defun run-sparql-tests ()
   (it.bese.fiveam:run! 'sparql-test:sparql-tests))




More information about the Isidorus-cvs mailing list