Author: lgiessmann Date: Sun Apr 3 17:12:18 2011 New Revision: 411 Log: TM-SPARQL: fixed a bug in the processing of the property tms:topicProperty; finished the unit-tests for triples of the form ?var1 ?var2 <obj> Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_special_uris.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 Sun Apr 3 17:12:18 2011 @@ -495,7 +495,8 @@ (filter-by-characteristic-value (value (object construct)) (literal-datatype (object construct)) :revision revision)) - ((iri-p (object construct)) + ((and (iri-p (object construct)) + (typep (value (object construct)) 'TopicC)) (filter-by-otherplayer (value (object construct)) :revision revision)))))) @@ -1073,8 +1074,6 @@ (remove-null (loop for triple in (select-group construct) append (remove-null - ;;TODO: replace remove-null by a function that check if any of the - ;; list items is nil, if so the entire list should be nil (list (when (variable-p (subject triple)) (list :variable (value (subject triple)) Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original) +++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Apr 3 17:12:18 2011 @@ -93,9 +93,16 @@ (setf (value pred) (get-item-by-psi *tms-player* :revision revision)) (let ((val (filter-for-player construct :revision revision))) (setf (value pred) old-pred-value) + val))) + (res-6 + (progn + (setf (value pred) (get-item-by-psi *tms-topicProperty* + :revision revision)) + (let ((val (filter-for-topicProperties construct :revision revision))) + (setf (value pred) old-pred-value) val)))) (setf (elem-type (predicate construct)) 'VARIABLE) - (append res-1 res-2 res-3 res-4 res-5)))) + (append res-1 res-2 res-3 res-4 res-5 res-6)))) (defgeneric filter-for-player (construct &key revision) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Apr 3 17:12:18 2011 @@ -2079,7 +2079,7 @@ (map 'list #'(lambda(item) (cond ((string= (getf item :variable) "pred1") ;one name without a type so it is not listed - (is (= (length (getf item :result)) 9))) + (is (= (length (getf item :result)) 17))) ((string= (getf item :variable) "pred2") (is (= (length (getf item :result)) 3)) (is-false (set-exclusive-or @@ -2110,15 +2110,26 @@ (concat "<" *tms-scope* ">")) :test #'string=))) ((string= (getf item :variable) "obj1") - (is (= (length (getf item :result)) 9)) - (is-false (set-exclusive-or - (getf item :result) - (list "Johann Wolfgang" "von Goethe" - "28.08.1749" "22.03.1832" "82" - "true" "false" - "<http://some.where/tmsparql/author>" - "<http://some.where/psis/poem/zauberlehrling>") - :test #'string=))) + (is (= (length (getf item :result)) 17)) + (is-true (find "Johann Wolfgang" (getf item :result) + :test #'string=)) + (is-true (find "von Goethe" (getf item :result) + :test #'string=)) + (is-true (find "true" (getf item :result) + :test #'string=)) + (is-true (find "false" (getf item :result) + :test #'string=)) + (is-true (find "28.08.1749" (getf item :result) + :test #'string=)) + (is-true (find "22.03.1832" (getf item :result) + :test #'string=)) + (is-true (find "82" (getf item :result) + :test #'string=)) + (is-true (find "<http://some.where/tmsparql/author>" + (getf item :result) :test #'string=)) + (is-true + (find "<http://some.where/psis/poem/zauberlehrling>" + (getf item :result) :test #'string=))) ((string= (getf item :variable) "obj2") (is (= (length (getf item :result)) 3)) (is-false @@ -2172,10 +2183,124 @@ r-1)))) +(test test-all-12 + "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 + "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> + SELECT * WHERE { + ?subj1 ?pred1 <http://some.where/tmsparql/author/goethe>. + ?subj2 ?pred2 <http://some.where/ii/goethe-variant>. + ?subj3 ?pred3 <http://some.where/ii/goethe-untyped-name>. + ?subj4 ?pred4 <http://some.where/ii/goethe-occ>. + ?subj5 ?pred5 <http://some.where/ii/association>. + ?subj6 ?pred6 <http://some.where/ii/role-2>. + ?subj7 ?pred7 <http://some.where/tmsparql/display-name>. + ?subj8 ?pred8 <http://some.where/ii/role-reifier>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 16)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "pred1") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (list (concat "<" *instance-psi* ">") + "<http://some.where/tmsparql/writer>" + (concat "<" *tms-player* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (list "<http://some.where/tmsparql/author>" + "<http://some.where/psis/poem/zauberlehrling>" + (concat + "_:r" + (write-to-string + (elephant::oid + (first + (player-in-roles + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0))))) + (concat + "_:r" + (write-to-string + (elephant::oid + (second + (player-in-roles + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0)))))) + (getf item :result) :test #'string=))) + ((or (string= (getf item :variable) "pred2") + (string= (getf item :variable) "pred5")) + (is-false (getf item :result))) + ((or (string= (getf item :variable) "subj2") + (string= (getf item :variable) "obj5")) + (is-false (getf item :result))) + ((or (string= (getf item :variable) "pred3") + (string= (getf item :variable) "pred4")) + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-topicProperty* ">")))) + ((or (string= (getf item :variable) "subj3") + (string= (getf item :variable) "obj4")) + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "<http://some.where/tmsparql/author/goethe>"))) + ((string= (getf item :variable) "pred6") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-role* ">")))) + ((string= (getf item :variable) "subj6") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "<http://some.where/ii/association>"))) + ((string= (getf item :variable) "pred7") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (list (concat "<" *tms-player* ">") + (concat "<" *tms-scope* ">") + (concat "<" *instance-psi* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj7") + (is (= (length (getf item :result)) 3)) + (is (find "<http://psi.topicmaps.org/tmcl/scope-type>" + (getf item :result) :test #'string=)) + (is (find "<http://some.where/ii/goethe-variant>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "pred8") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (list (concat "<" *tms-player* ">") + (concat "<" *tms-reifier* ">") + (concat "<" *instance-psi* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj8") + (is (= (length (getf item :result)) 3)) + (set-exclusive-or + (list "http://some.where/tmsparql/reifier-type" + (concat + "_:r" + (write-to-string + (elephant::oid + (first + (player-in-roles + (get-item-by-item-identifier + "http://some.where/ii/role-reifier" + :revision 0) :revision 0)))))) + (getf item :result) :test #'string=)))) + r-1)))) + + + + -;TODO: complex filter, -; complex relations between variables -; ?subj ?pred <obj> +;TODO: test complex filters, +; test complex relations between variables ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/> ; SELECT * WHERE { ; ?assoc tms:reifier <http://some.where/ii/association-reifier>.