Author: lgiessmann Date: Fri Apr 1 10:40:07 2011 New Revision: 405 Log: TM-SPARQL: finsihed the unit-tests for the special-uri of the form <subj> <pred> <obj> => fixed a bug with names playing the role of object-resources 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 Fri Apr 1 10:40:07 2011 @@ -780,7 +780,9 @@ subj pred (value (object construct)) (literal-datatype (object construct)) :revision revision))) ((and (iri-p (object construct)) - (typep subj 'TopicC)) + (typep subj 'TopicC) + (or (variable-p (object construct)) + (typep (value (object construct)) 'TopicC))) (filter-associations subj pred (value (object construct)) :revision revision))))))) 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 Fri Apr 1 10:40:07 2011 @@ -253,14 +253,19 @@ (literal-p obj))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) - (when (or (and (typep subj 'NameC) - (string= literal-datatype *xml-string*) + (if (typep (value subj) 'NameC) + (when (and (string= literal-datatype *xml-string*) (string= (charvalue (value subj)) (value obj))) - (filter-datatypable-by-value subj obj literal-datatype)) - (list (list :subject subj-uri - :predicate pred-uri - :object (value obj) - :literal-datatype literal-datatype)))) + (list (list :subject subj-uri + :predicate pred-uri + :object (value obj) + :literal-datatype literal-datatype))) + (when (filter-datatypable-by-value (value subj) (value obj) + literal-datatype) + (list (list :subject subj-uri + :predicate pred-uri + :object (value obj) + :literal-datatype literal-datatype))))) ((not (variable-p subj)) (list (list :subject subj-uri :predicate pred-uri 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 1 10:40:07 2011 @@ -1926,9 +1926,28 @@ r-1)))) +(test test-all-9 + "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 { + <http://some.where/tmsparql/author/goethe> a <http://some.where/tmsparql/author>. + <http://some.where/ii/goethe-occ> tms:reifier <http://some.where/ii/goethe-occ-reifier>. + <http://some.where/ii/association> tms:role <http://some.where/ii/role-2>. + <http://some.where/ii/role-2> tms:player <http://some.where/psis/poem/zauberlehrling>. + <http://some.where/tmsparql/author/goethe> tms:topicProperty <http://some.where/ii/goethe-untyped-name>. + <http://some.where/ii/goethe-variant> tms:scope <http://some.where/tmsparql/display-name>. + <http://some.where/ii/goethe-untyped-name> tms:value 'Johann Wolfgang von Goethe'" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-false r-1)))) -;TODO: tms:value, complex filter, -; <obj> <pred> <subj>, + + + +;TODO: complex filter, ; ?obj <pred> ?subj, ; <subj> ?pred ?obj, ; ?subj ?pred <obj>