[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