April 2011 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r409 - trunk/src/TM-SPARQL
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 15:10:07 2011 New Revision: 409 Log: TM-SPARQL: fixed a bug in the macro with-triple-nodes that appears with the latest changes with special-uris Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp 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 15:10:07 2011 @@ -18,12 +18,15 @@ `(let* ((subj (subject ,triple-construct)) (pred (predicate ,triple-construct)) (obj (object ,triple-construct)) - (subj-uri (unless (variable-p subj) + (subj-uri (when (and (not (variable-p subj)) + (value subj)) (sparql-node (value subj) :revision revision))) - (pred-uri (unless (variable-p pred) + (pred-uri (when (and (not (variable-p pred)) + (value pred)) (sparql-node (value pred) :revision revision))) (obj-uri (when (and (not (variable-p obj)) - (not (literal-p obj))) + (not (literal-p obj)) + (value obj)) (sparql-node (value obj) :revision revision))) (literal-datatype (when (literal-p obj) (literal-datatype obj)))) @@ -386,7 +389,7 @@ (get-all-topics revision))))) (loop for top in topics collect (list :subject - (sparql-node (reified-construct top :revision revision) - :revision revision) - :predicate pred-uri - :object (sparql-node top :revision revision))))))))))) \ No newline at end of file + (sparql-node (reified-construct top :revision revision) + :revision revision) + :predicate pred-uri + :object (sparql-node top :revision revision))))))))))) \ No newline at end of file

1 0

[isidorus-cvs] r408 - trunk/src/unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 14:36:47 2011 New Revision: 408 Log: fixed a svn problem Modified: trunk/src/unit_tests/sparql_test.lisp 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 14:36:47 2011 @@ -2075,6 +2075,7 @@ "}")) (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) (is-true (= (length r-1) 12)) + (format t "~a~%" r-1))))

1 0

[isidorus-cvs] r407 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 12:52:05 2011 New Revision: 407 Log: TM-SPARQL: fixed a bug in the setter for elem-type (SPARQL-Triple-Elem) 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 12:52:05 2011 @@ -242,17 +242,17 @@ (push triple (slot-value construct 'select-group)))) -(defgeneric (setf elem-type) (construct elem-type) +(defgeneric (setf elem-type) (value construct) (:documentation "Sets the passed elem-type on the passed cosntruct.") - (:method ((construct SPARQL-Triple-Elem) (elem-type Symbol)) - (when (and (not (eql elem-type 'IRI)) - (not (eql elem-type 'VARIABLE)) - (not (eql elem-type 'LITERAL))) + (:method ((value Symbol) (construct SPARQL-Triple-Elem)) + (when (and (not (eql value 'IRI)) + (not (eql value 'VARIABLE)) + (not (eql value 'LITERAL))) (error (make-condition 'bad-argument-error :message (format nil "Expected a one of the symbols ~a, but get ~a~%" - '('IRI 'VARIABLE 'LITERAL) elem-type)))) - (setf (slot-value construct 'elem-type) elem-type))) + '('IRI 'VARIABLE 'LITERAL) value)))) + (setf (slot-value construct 'elem-type) value))) (defgeneric add-prefix (construct prefix-label prefix-value) @@ -771,9 +771,9 @@ (cond ((variable-p (object construct)) (when (typep subj 'TopicC) (append (filter-characteristics - subj pred nil nil :revision revision) - (filter-associations - subj pred nil :revision revision)))) + subj pred nil nil :revision revision) + (filter-associations + subj pred nil :revision revision)))) ((literal-p (object construct)) (when (typep subj 'TopicC) (filter-characteristics 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 12:52:05 2011 @@ -58,6 +58,7 @@ and its objects corresponding to the defined special-uris, e.g. <subj> var <obj>.") (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (setf (elem-type (predicate construct)) 'IRI) (let* ((pred (predicate construct)) (old-pred-value (value pred)) (res-1 @@ -90,6 +91,7 @@ (let ((val (filter-for-player 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)))) 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 12:52:05 2011 @@ -2059,6 +2059,24 @@ r-1)))) +(test test-all-11 + "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> ?pred1 ?obj1. + <http://some.where/ii/association> ?pred2 ?obj2. + <http://some.where/ii/role-2> ?pred3 ?obj3. + <http://some.where/ii/goethe-untyped-name> ?pred4 ?obj4. + <http://some.where/ii/goethe-occ> ?pred5 ?obj5. + <http://some.where/ii/goethe-variant> ?pred6 ?obj6" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 12)) + (format t "~a~%" r-1)))) + ;TODO: complex filter,

1 0

[isidorus-cvs] r406 - in trunk/src: model unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 11:45:32 2011 New Revision: 406 Log: TM-SPARQL: finsihed the unit-tests for the special-uri of the form ?var1 <pred> ?var2 => fixed a bug in get-db-instances-by-class Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Apr 1 11:45:32 2011 @@ -751,7 +751,8 @@ (if revision (remove-null (map 'list #'(lambda(inst) - (if (typep inst 'CHaracteristicC) + (if (or (typep inst 'CharacteristicC) + (typep inst 'RoleC)) (find-item-by-revision inst revision (parent inst :revision revision)) (find-item-by-revision inst revision))) 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 11:45:32 2011 @@ -1852,7 +1852,8 @@ "<http://some.where/tmsparql/author/goethe>"))) ((string= (getf item :variable) "props") (is (= (length (getf item :result)) 8)) - (is-false (intersection prop-ids (getf item :result)))) + (is-false (set-exclusive-or prop-ids (getf item :result) + :test #'string=))) (t (is-true (format t "bad variable-name found"))))) r-1)))) @@ -1945,10 +1946,123 @@ (is-false r-1)))) +(test test-all-10 + "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 a ?obj1. + ?subj2 tms:reifier ?obj2. + ?subj3 tms:role ?obj3. + ?subj4 tms:player ?obj4. + ?subj5 tms:topicProperty ?obj5. + ?subj6 tms:scope ?obj6. + ?subj7 tms:value ?obj7" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is (= (length r-1) 14)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "subj1") + (is (= (length (getf item :result)) 29))) + ((string= (getf item :variable) "obj2") + (is (= (length (getf item :result)) 4)) + (is-false (set-exclusive-or + (getf item :result) + (list "<http://some.where/ii/goethe-name-reifier>" + "<http://some.where/ii/goethe-occ-reifier>" + "<http://some.where/ii/association-reifier>" + "<http://some.where/ii/role-reifier>") + :test #'string=))) + ((string= (getf item :variable) "subj3") + (is (= (length (getf item :result)) 60)) + (is (find "<http://some.where/ii/association>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj4") + (is (= (length (getf item :result)) 60))) + ((string= (getf item :variable) "subj5") + (is (= (length (getf item :result)) 10))) + ((string= (getf item :variable) "subj6") + (is (= (length (getf item :result)) 2)) + (set-exclusive-or + (getf item :result) + (list "<http://some.where/ii/zb/occurrence>" + "<http://some.where/ii/goethe-variant>") + :test #'string=)) + ((string= (getf item :variable) "subj7") + (is (= (length (getf item :result)) 11))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 29))) + ((string= (getf item :variable) "subj2") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (getf item :result) + (list + "<http://some.where/ii/goethe-occ>" + "<http://some.where/ii/association>" + (concat + "_:r" + (write-to-string + (elephant::oid + (loop for role in + (roles (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0) :revision 0) + when (string= + (uri (first + (psis (player role :revision 0) + :revision 0))) + "http://some.where/tmsparql/author/goethe") + return role)))) + (concat + "_:n" + (write-to-string + (elephant::oid + (loop for name in + (names + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0) + when (string= (charvalue name) "von Goethe") + return name))))) + :test #'string=))) + ((string= (getf item :variable) "obj3") + (is (= (length (getf item :result)) 60)) + (is (find "<http://some.where/ii/role-2>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "obj4") + (is (= (length (getf item :result)) 60))) + ((string= (getf item :variable) "obj5") + (is (= (length (getf item :result)) 10))) + ((string= (getf item :variable) "obj6") + (is (= (length (getf item :result)) 2)) + (set-exclusive-or + (getf item :result) + (list "<http://some.where/tmsparql/display-name>" + "<http://some.where/tmsparql/de>"))) + ((string= (getf item :variable) "obj7") + (is (= (length (getf item :result)) 11)) + (set-exclusive-or + (getf item :result) + (list "Johann Wolfgang" "von Goethe" + "Johann Wolfgang von Goethe" "Der Zauberlehrling" + "28.08.1749" "22.03.1832" "82" "true" "false" + "Hat der alte Hexenmeister + sich doch einmal wegbegeben! + ... + ") + :test #'string=)) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + ;TODO: complex filter, -; ?obj <pred> ?subj, +; complex relations between variables ; <subj> ?pred ?obj, ; ?subj ?pred <obj> ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/>

1 0

[isidorus-cvs] r405 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

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>

1 0

[isidorus-cvs] r404 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 09:57:58 2011 New Revision: 404 Log: TM-SPARQL: finsihed the unit-tests for the special-uri tms:value => fixed a bug when '<date>'^^xml-date is given Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_special_uris.lisp trunk/src/unit_tests/sparql_test.lisp trunk/src/unit_tests/sparql_test.xtm Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Fri Apr 1 09:57:58 2011 @@ -505,7 +505,8 @@ Note the type xsd:date is not supported and so handled as a string." (declare (String literal-datatype)) (let ((chars - (cond ((string= literal-datatype *xml-string*) + (cond ((or (string= literal-datatype *xml-string*) + (string= literal-datatype *xml-date*)) (remove-if #'(lambda(elem) (string/= (charvalue elem) literal-value)) (append 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 09:57:58 2011 @@ -255,7 +255,7 @@ (not (variable-p obj))) (when (or (and (typep subj 'NameC) (string= literal-datatype *xml-string*) - (string= (charvalue subj) (value obj))) + (string= (charvalue (value subj)) (value obj))) (filter-datatypable-by-value subj obj literal-datatype)) (list (list :subject subj-uri :predicate pred-uri @@ -264,10 +264,10 @@ ((not (variable-p subj)) (list (list :subject subj-uri :predicate pred-uri - :object (charvalue subj) - :literal-datatype (if (typep subj 'd:NameC) + :object (charvalue (value subj)) + :literal-datatype (if (typep (value subj) 'd:NameC) *xml-string* - (datatype subj))))) + (datatype (value subj)))))) ((not (variable-p obj)) (loop for char in (return-characteristics (value obj) literal-datatype) collect (list :subject (sparql-node char :revision revision) 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 09:57:58 2011 @@ -1882,12 +1882,55 @@ r-1)))) +(test test-all-8 + "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/ii/goethe-untyped-name> tms:value ?obj1. + <http://some.where/ii/goethe-occ> tms:value ?obj2. + <http://some.where/ii/goethe-variant> tms:value ?obj3. + ?subj1 tms:value 'Goethe'. + ?subj2 tms:value '28.08.1749'^^http://www.w3.org/2001/XMLSchema#date. + ?subj3 tms:value 'Johann Wolfgang von Goethe'. + ?subj4 tms:value 82" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 7)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "obj1") + (is (string= (first (getf item :result)) + "Johann Wolfgang von Goethe"))) + ((string= (getf item :variable) "obj2") + (is (string= (first (getf item :result)) + "28.08.1749"))) + ((string= (getf item :variable) "obj3") + (is (string= (first (getf item :result)) + "Goethe"))) + ((string= (getf item :variable) "subj1") + (is (string= (first (getf item :result)) + "<http://some.where/ii/goethe-variant>"))) + ((string= (getf item :variable) "subj2") + (is (string= (first (getf item :result)) + "<http://some.where/ii/goethe-occ>"))) + ((string= (getf item :variable) "subj3") + (is (string= (first (getf item :result)) + "<http://some.where/ii/goethe-untyped-name>"))) + ((string= (getf item :variable) "subj4") + (is (string= (first (getf item :result)) + "<http://some.where/ii/goethe-years-occ>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + -;TODO: tms:scope, tms:value, complex filter -; <obj> <pred> <subj> -; ?obj <pred> ?subj -; <subj> ?pred ?obj +;TODO: tms:value, complex filter, +; <obj> <pred> <subj>, +; ?obj <pred> ?subj, +; <subj> ?pred ?obj, ; ?subj ?pred <obj> ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/> ; SELECT * WHERE { Modified: trunk/src/unit_tests/sparql_test.xtm ============================================================================== --- trunk/src/unit_tests/sparql_test.xtm (original) +++ trunk/src/unit_tests/sparql_test.xtm Fri Apr 1 09:57:58 2011 @@ -141,6 +141,7 @@ <tm:type><tm:topicRef href="#last-name"/></tm:type> <tm:value>von Goethe</tm:value> <tm:variant> + <tm:itemIdentity href="http://some.where/ii/goethe-variant"/> <tm:scope><tm:topicRef href="#display-name"/></tm:scope> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Goethe</tm:resourceData> </tm:variant> @@ -159,6 +160,7 @@ <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData> </tm:occurrence> <tm:occurrence> + <tm:itemIdentity href="http://some.where/ii/goethe-years-occ"/> <tm:type><tm:topicRef href="#years"/></tm:type> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#integer">82</tm:resourceData> </tm:occurrence>

1 0

[isidorus-cvs] r403 - trunk/src/unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 09:30:30 2011 New Revision: 403 Log: TM-SPARQL: finsihed the unit-tests for the special-uri tms:scope Modified: trunk/src/unit_tests/sparql_test.lisp trunk/src/unit_tests/sparql_test.xtm 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 09:30:30 2011 @@ -1858,6 +1858,30 @@ r-1)))) +(test test-all-7 + "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/ii/zb/occurrence> tms:scope ?scope. + ?owner tms:scope <http://some.where/tmsparql/de>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 2)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "scope") + (is (string= (first (getf item :result)) + "<http://some.where/tmsparql/de>"))) + ((string= (getf item :variable) "owner") + (is (string= (first (getf item :result)) + "<http://some.where/ii/zb/occurrence>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + ;TODO: tms:scope, tms:value, complex filter Modified: trunk/src/unit_tests/sparql_test.xtm ============================================================================== --- trunk/src/unit_tests/sparql_test.xtm (original) +++ trunk/src/unit_tests/sparql_test.xtm Fri Apr 1 09:30:30 2011 @@ -191,6 +191,7 @@ <tm:value>Der Zauberlehrling</tm:value> </tm:name> <tm:occurrence> + <tm:itemIdentity href="http://some.where/ii/zb/occurrence"/> <tm:type><tm:topicRef href="#poem-content"/></tm:type> <tm:scope><tm:topicRef href="#de"/></tm:scope> <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister

1 0

[isidorus-cvs] r402 - trunk/src/unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 09:23:24 2011 New Revision: 402 Log: TM-SPARQL: finsihed the unit-tests for the special-uri tms:topicProperty Modified: trunk/src/unit_tests/sparql_test.lisp 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 09:23:24 2011 @@ -1787,7 +1787,6 @@ r-1)))) - (test test-all-5 "Tests the entire module with the file sparql_test.xtm" (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*) @@ -1817,9 +1816,51 @@ r-1)))) +(test test-all-6 + "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> tms:topicProperty ?props. + ?subj1 tms:topicProperty <http://some.where/ii/goethe-untyped-name>. + ?subj2 tms:topicProperty <http://some.where/ii/goethe-occ>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))) + (prop-ids + (map 'list + #'(lambda(prop) + (if (item-identifiers prop :revision 0) + (concat "<" (d:uri (first (item-identifiers + prop :revision 0))) ">") + (if (typep prop 'OccurrenceC) + (concat "_:o" (write-to-string (elephant::oid prop))) + (concat "_:n" (write-to-string (elephant::oid prop)))))) + (append (names (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0)) + (occurrences (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0)))))) + (is-true (= (length r-1) 3)) + (map 'list #'(lambda(item) + (cond ((or (string= (getf item :variable) "subj1") + (string= (getf item :variable) "subj2")) + (is (string= + (first (getf item :result)) + "<http://some.where/tmsparql/author/goethe>"))) + ((string= (getf item :variable) "props") + (is (= (length (getf item :result)) 8)) + (is-false (intersection prop-ids (getf item :result)))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + -;TODO: tms:topicProperty, tms:scope, tms:value, complex filter +;TODO: tms:scope, tms:value, complex filter ; <obj> <pred> <subj> ; ?obj <pred> ?subj ; <subj> ?pred ?obj

1 0

[isidorus-cvs] r401 - trunk/src/unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 09:05:56 2011 New Revision: 401 Log: TM-SPARQL: finsihed the unit-tests for the special-uri tms:player Modified: trunk/src/unit_tests/sparql_test.lisp 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 09:05:56 2011 @@ -1788,11 +1788,44 @@ +(test test-all-5 + "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/ii/role-2> tms:player ?player. + ?role tms:player <http://some.where/psis/poem/zauberlehrling>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 2)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "player") + (is (string= + (first (getf item :result)) + "<http://some.where/psis/poem/zauberlehrling>"))) + ((string= (getf item :variable) "role") + (is (= (length (getf item :result)) 2)) + ;one role is the type-instance role + (is (or (string= (first (getf item :result)) + "<http://some.where/ii/role-2>") + (string= (second (getf item :result)) + "<http://some.where/ii/role-2>")))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) -;TODO: tms:player, tms:topicProperty, tms:scope, tms:value, complex filter -;TODO: "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> -; SELECT * WHERE { + + +;TODO: tms:topicProperty, tms:scope, tms:value, complex filter +; <obj> <pred> <subj> +; ?obj <pred> ?subj +; <subj> ?pred ?obj +; ?subj ?pred <obj> +;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/> +; SELECT * WHERE { ; ?assoc tms:reifier <http://some.where/ii/association-reifier>. ; ?assoc tms:role ?roles} ; => ?assoc = http://some.where/ii/association

1 0

[isidorus-cvs] r400 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 08:50:49 2011 New Revision: 400 Log: TM-SPARQL: finsihed the unit-tests for the special-uri tms:role => fixed a bug when the object is a resource and not a variable Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_special_uris.lisp trunk/src/unit_tests/sparql_test.lisp trunk/src/unit_tests/sparql_test.xtm Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Fri Apr 1 08:50:49 2011 @@ -16,10 +16,9 @@ :init-tm-sparql)) - (in-package :TM-SPARQL) -(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels") +(defvar *empty-label* "_empty_label_symbol" "A label symbol for empyt prefix labels") (defvar *equal-operators* nil "A Table taht contains tuples of classes and equality operators.") @@ -779,7 +778,8 @@ (filter-characteristics subj pred (value (object construct)) (literal-datatype (object construct)) :revision revision))) - ((iri-p (object construct)) + ((and (iri-p (object construct)) + (typep subj '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 08:50:49 2011 @@ -151,7 +151,7 @@ (when (and (or (variable-p subj) (typep (value subj) 'd:AssociationC)) (or (variable-p obj) - (typep (value subj) 'd:RoleC))) + (typep (value obj) 'd:RoleC))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (find obj (roles (value subj) :revision revision)) 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 08:50:49 2011 @@ -1744,12 +1744,59 @@ (let* ((q-1 (concat "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> SELECT * WHERE { - <http://some.where/ii/goethe-occ> tms:reifier ?obj1. - ?subj1 tms:reifier <http://some.where/ii/goethe-name-reifier>" + ?assoc tms:reifier <http://some.where/ii/association-reifier>. + <http://some.where/ii/association> tms:role ?roles. + ?assoc2 tms:role <http://some.where/ii/role-2>" "}")) - (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) - (is-true (= (length r-1) 2)) - ))) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))) + (role-1 (concat "_:r" (write-to-string + (elephant::oid + (first (roles + (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0))))))) + (role-2 (concat "_:r" (write-to-string + (elephant::oid + (second (roles + (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0)))))))) + (is-true (= (length r-1) 3)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "assoc") + (is (string= (first (getf item :result)) + "<http://some.where/ii/association>"))) + ((string= (getf item :variable) "roles") + (is (or (string= (first (getf item :result)) + role-1) + (string= (first (getf item :result)) + role-2) + (string= (first (getf item :result)) + "<http://some.where/ii/role-2>"))) + (is (or (string= (second (getf item :result)) + role-1) + (string= (second (getf item :result)) + role-2) + (string= (second (getf item :result)) + "<http://some.where/ii/role-2>")))) + ((string= (getf item :variable) "assoc2") + (is (string= (first (getf item :result)) + "<http://some.where/ii/association>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + + + + +;TODO: tms:player, tms:topicProperty, tms:scope, tms:value, complex filter +;TODO: "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> +; SELECT * WHERE { +; ?assoc tms:reifier <http://some.where/ii/association-reifier>. +; ?assoc tms:role ?roles} +; => ?assoc = http://some.where/ii/association +; => ?roles = (http://some.where/ii/role-2, _:r????) (defun run-sparql-tests () Modified: trunk/src/unit_tests/sparql_test.xtm ============================================================================== --- trunk/src/unit_tests/sparql_test.xtm (original) +++ trunk/src/unit_tests/sparql_test.xtm Fri Apr 1 08:50:49 2011 @@ -201,13 +201,14 @@ </tm:topic> <tm:association reifier="http://some.where/ii/association-reifier"> - <tm:itemIdentity href="http://somw.where/ii/association"/> + <tm:itemIdentity href="http://some.where/ii/association"/> <tm:type><tm:topicRef href="#written-by"/></tm:type> <tm:role reifier="http://some.where/ii/role-reifier"> <tm:type><tm:topicRef href="#writer"/></tm:type> <tm:topicRef href="#goethe"/> </tm:role> <tm:role> + <tm:itemIdentity href="http://some.where/ii/role-2"/> <tm:type><tm:topicRef href="#written"/></tm:type> <tm:topicRef href="#zauberlehrling"/> </tm:role>

1 0