Author: lgiessmann Date: Mon Dec 20 11:25:53 2010 New Revision: 378 Log: TM-SPARQL: adapted some unit-tests to the latest changes; fixed a bug when calculating the final result 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 Mon Dec 20 11:25:53 2010 @@ -271,9 +271,14 @@ (concatenate 'string "(" (value (object construct)) " " (elt (object-result construct) row-idx) ")"))) (var-let - (concatenate 'string "(let ((true t) (false nil)" + (concatenate 'string "(let ((true t) (false nil) " subj-var pred-var obj-var ")")) - (expression (concatenate 'string var-let filter-string ")"))) + (expression + (concatenate 'string var-let "(cl:handler-case " + filter-string + "(exception:sparql-parser-error (err) " + "(cl:in-package :cl-user) " + "(error err)))"))) (when (eval (read-from-string expression)) (push (list :subject (elt (subject-result construct) row-idx) :predicate (elt (predicate-result construct) row-idx) @@ -945,11 +950,16 @@ (when var-elem (let* ((rows-to-hold (remove-null - (map 'list #'(lambda(val) - (if (stringp val) - (position val var-elem :test #'string=) - (position val var-elem))) - dont-touch-values))) + (map 'list #'(lambda(res) + (when (cond + ((stringp res) + (find res dont-touch-values :test #'string=)) + ((numberp res) + (find res dont-touch-values :test #'=)) + (t + (find res dont-touch-values))) + (position res var-elem))) + var-elem))) (new-result-list (map 'list #'(lambda(row-idx) Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Mon Dec 20 11:25:53 2010 @@ -122,10 +122,6 @@ construct filter-string-functions original-filter-string)) (parse-group construct next-query)))) ;;TODO: implement - ;; *implement wrapper functions, also for the operators - ;; it would be nice when the self defined operator functions would be in a - ;; separate packet, e.g. filter-functions, so =, ... would couse no - ;; collisions ;; *add ^^datatype to the object-literal-results ;; *implement to-literal => CharacteristicC => \"...\"^^datatype => use for tm-sparql Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Mon Dec 20 11:25:53 2010 @@ -37,7 +37,8 @@ :test-set-*-and-/-operators :test-set-+-and---operators :test-set-compare-operators - :test-set-functions)) + :test-set-functions + :test-module-1)) (in-package :sparql-test) @@ -472,7 +473,7 @@ (string= obj-1 "<http://some.where/psis/der_zauberlehrling>"))) (is (or (string= subj-2 "<http://some.where/psis/author/goethe>") (string= subj-2 "<http://some.where/psis/persons/goethe>"))) - (is (string= pred-1 "<http://psi.topicmaps.org/iso13250/model/type>")) + (is (string= pred-1 "<http://psi.topicmaps.org/iso13250/model/instance>")) (is (or (string= obj-2 "<http://some.where/psis/poem/zauberlehrling>") (string= obj-2 "<http://some.where/psis/der_zauberlehrling>")))) (t @@ -867,7 +868,7 @@ (is (= (length (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) 0)) (is (= (length (tm-sparql::subject-result - (second (tm-sparql::select-group q-obj-3)))) 1)) + (second (tm-sparql::select-group q-obj-3)))) 0)) (is (or (string= "<http://some.where/psis/author/goethe>" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1))))) @@ -922,18 +923,12 @@ (first (tm-sparql::select-group q-obj-3))))) (is-false (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3))))) - (is (or (string= "<http://some.where/psis/author/goethe>" - (first (tm-sparql::subject-result - (second (tm-sparql::select-group q-obj-3))))) - (string= "<http://some.where/psis/persons/goethe>" - (first (tm-sparql::subject-result - (second (tm-sparql::select-group q-obj-3))))))) - (is (string= "<http://some.where/base-psis/last-name>" - (first (tm-sparql::predicate-result - (second (tm-sparql::select-group q-obj-3)))))) - (is (string= "von Goethe" - (first (tm-sparql::object-result - (second (tm-sparql::select-group q-obj-3)))))))))) + (is-false (first (tm-sparql::subject-result + (second (tm-sparql::select-group q-obj-3))))) + (is-false (first (tm-sparql::predicate-result + (second (tm-sparql::select-group q-obj-3))))) + (is-false (first (tm-sparql::object-result + (second (tm-sparql::select-group q-obj-3))))))))) (test test-result @@ -1528,7 +1523,43 @@ "(or(progn(DATATYPE?var3))(progn(isLITERAL(=(one+?var1)(one-?var2)))))")) (is (string= (string-replace result-5-6 " " "") "(or(progn(DATATYPE?var3))(progn(progn(isLITERAL(=(one+?var1)(one-?var2))))))")))) - + + +;(test test-module-1 +; "Tests the entire module." +; (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) +; (with-revision 0 +; (let* ((query-1 +; "BASE <http://some.where/psis/poem/> +; SELECT $subject ?predicate WHERE{ +; ?subject $predicate <zauberlehrling> . +; FILTER (STR(?predicate) = 'http://some.where/base-psis/written')}") +; (query-2 "SELECT ?object ?subject WHERE{ +; <http://some.where/psis/author/goethe> ?prediate ?object . +; FILTER (isLITERAL(?object) && +; DATATYPE(?object) = +; 'http://www.w3.org/2001/XMLSchema#string')}") +; (query-3 "SELECT ?object ?subject WHERE{ +; <http://some.where/psis/author/goethe> ?prediate ?object . +; FILTER (notAllowed(?subject)}") +; (query-4 "SELECT ?object ?subject WHERE{ +; <http://some.where/psis/author/goethe> ?prediate ?object . +; FILTER ((notAllowed ?subject))}") +; (query-5 "SELECT ?object ?subject WHERE{ +; <http://some.where/psis/author/goethe> ?prediate ?object . +; FILTER(?a && (?b || ?c)}") +; (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) +; (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))) +; (is-true q-obj-1) +; (is-true q-obj-2) +; (signals excpetions-sparql-parser-error +; (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)) +; (signals excpetions-sparql-parser-error +; (make-instance 'TM-SPARQL:SPARQL-Query :query query-4)) +; (signals excpetions-sparql-parser-error +; (make-instance 'TM-SPARQL:SPARQL-Query :query query-5)) +; ;;TODO: implement +; )))) (defun run-sparql-tests ()