isidorus-cvs April 2011

isidorus-cvs@common-lisp.net

1 participants
32 discussions

[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

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

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 07:22:42 2011 New Revision: 399 Log: TM-SPARQL: finished the unit-tests for the special predicate tms:reifier; fixed a problem with 2-dim. lists; fixed a bug in get-item-by-content; added get-most-recent-version to CharacteristicC, PointerC, and RoleC Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_special_uris.lisp trunk/src/model/datamodel.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 07:22:42 2011 @@ -769,14 +769,16 @@ (pred (when (iri-p (predicate construct)) (value (predicate construct))))) (cond ((variable-p (object construct)) - (append (filter-characteristics - subj pred nil nil :revision revision) - (filter-associations - subj pred nil :revision revision))) + (when (typep subj 'TopicC) + (append (filter-characteristics + subj pred nil nil :revision revision) + (filter-associations + subj pred nil :revision revision)))) ((literal-p (object construct)) - (filter-characteristics - subj pred (value (object construct)) - (literal-datatype (object construct)) :revision revision)) + (when (typep subj 'TopicC) + (filter-characteristics + subj pred (value (object construct)) + (literal-datatype (object construct)) :revision revision))) ((iri-p (object construct)) (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 07:22:42 2011 @@ -114,16 +114,19 @@ (let ((player-top (player (value subj) :revision revision))) (when player-top - (list :subject subj-uri - :predicate pred-uri - :object (sparql-node player-top :revision revision))))) + (list + (list + :subject subj-uri + :predicate pred-uri + :object (sparql-node player-top :revision revision)))))) ((not (variable-p obj)) (let ((parent-roles (player-in-roles (value obj) :revision revision))) (loop for role in parent-roles - collect (list :subject (sparql-node role :revision revision) - :predicate pred-uri - :object (sparql-node (player role :revision revision) + collect (list + :subject (sparql-node role :revision revision) + :predicate pred-uri + :object (sparql-node (player role :revision revision) :revision revision))))) (t ; only pred is given (let ((all-roles @@ -163,9 +166,10 @@ ((not (variable-p obj)) (let ((parent-assoc (parent (value obj) :revision revision))) (when revision - (list :subject (sparql-node parent-assoc :revision revision) - :predicate pred-uri - :object obj-uri)))) + (list + (list :subject (sparql-node parent-assoc :revision revision) + :predicate pred-uri + :object obj-uri))))) (t ; only pred is given (let ((assocs (remove-null @@ -211,9 +215,10 @@ ((not (variable-p obj)) (let ((parent-top (parent (value obj) :revision revision))) (when revision - (list :subject (sparql-node parent-top :revision revision) - :predicate pred-uri - :object obj-uri)))) + (list + (list :subject (sparql-node parent-top :revision revision) + :predicate pred-uri + :object obj-uri))))) (t ; only pred is given (let ((topics (remove-null @@ -353,9 +358,10 @@ (let ((reifier-top (reifier (value subj) :revision revision))) (when reifier-top - (list :subject subj-uri - :predicate pred-uri - :object (sparql-node reifier-top :revision revision))))) + (list + (list :subject subj-uri + :predicate pred-uri + :object (sparql-node reifier-top :revision revision)))))) ((not (variable-p obj)) (let ((reified-cons (reified-construct (value obj) :revision revision))) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Apr 1 07:22:42 2011 @@ -749,10 +749,13 @@ (typep inst class-symbol)) db-instances))) (if revision - (remove-if #'null - (map 'list #'(lambda(inst) - (find-item-by-revision inst revision)) - filtered-instances)) + (remove-null + (map 'list #'(lambda(inst) + (if (typep inst 'CHaracteristicC) + (find-item-by-revision inst revision + (parent inst :revision revision)) + (find-item-by-revision inst revision))) + filtered-instances)) filtered-instances)))) @@ -809,15 +812,17 @@ (defun get-item-by-content (content &key (revision *TM-REVISION*)) "Finds characteristics by their (atomic) content." - (flet - ((get-existing-instances (class-symbol) - (delete-if-not - #'(lambda (constr) - (find-item-by-revision constr revision)) - (elephant:get-instances-by-value class-symbol 'charvalue content)))) - (nconc (get-existing-instances 'OccurenceC) - (get-existing-instances 'NameC) - (get-existing-instances 'VariantC)))) + (let ((constructs + (nconc (elephant:get-instances-by-value 'NameC 'Charvalue content) + (elephant:get-instances-by-value 'OccurrenceC 'Charvalue content) + (elephant:get-instances-by-value 'VariantC 'Charvalue content)))) + (first + (remove-if + #'(lambda(construct) + (or (string/= (charvalue construct) content) + (not (find-item-by-revision construct revision + (parent construct :revision revision))))) + constructs)))) (defmacro with-revision (revision &rest body) @@ -1154,6 +1159,24 @@ construct))) +(defmethod find-most-recent-revision ((construct CharacteristicC)) + (loop for c-assoc in (slot-p construct 'parent) + when (find-most-recent-revision c-assoc) + return construct)) + + +(defmethod find-most-recent-revision ((construct PointerC)) + (loop for p-assoc in (slot-p construct 'identified-construct) + when (find-most-recent-revision p-assoc) + return construct)) + + +(defmethod find-most-recent-revision ((construct RoleC)) + (loop for r-assoc in (slot-p construct 'parent) + when (find-most-recent-revision r-assoc) + return construct)) + + (defun add-version-info(construct start-revision) "Adds 'construct' to the given version. If the construct is a VersionedConstructC add-to-version-history 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 07:22:42 2011 @@ -1709,5 +1709,48 @@ r-1)))) +(test test-all-3 + "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-occ> tms:reifier ?obj1. + ?subj1 tms:reifier <http://some.where/ii/goethe-name-reifier>" + "}")) + (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) "subj1") + (is (string= + (first (getf item :result)) + (concat "_:n" + (write-to-string + (elephant::oid + (d:get-item-by-content "von Goethe"))))))) + ((string= (getf item :variable) "obj1") + (is (string= (first (getf item :result)) + "<http://some.where/ii/goethe-occ-reifier>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + +(test test-all-4 + "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-occ> tms:reifier ?obj1. + ?subj1 tms:reifier <http://some.where/ii/goethe-name-reifier>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 2)) + ))) + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

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

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 06:04:00 2011 New Revision: 398 Log: TM-SPARQL: finished unit-tests for the special predicates rdf:type, a, and tmdm:type => fixed a problem with rdf:type Modified: trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Fri Apr 1 06:04:00 2011 @@ -144,7 +144,14 @@ :elem-type 'IRI :value *type-psi*))) ((string-starts-with trimmed-str "<") - (parse-base-suffix-pair construct trimmed-str)) + (let ((result (parse-base-suffix-pair construct trimmed-str))) + (if (and (not (variable-p (getf result :value))) + (string= (value (getf result :value)) *rdf-type*)) + (list :next-query (getf result :next-query) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value *type-psi*)) + result))) ((or (string-starts-with trimmed-str "?") (string-starts-with trimmed-str "$")) (let ((result @@ -166,8 +173,14 @@ trimmed-str (original-query construct) "an IRI of the form prefix:suffix or <iri> but found a literal."))) (parse-literal-elem construct trimmed-str)) - (parse-prefix-suffix-pair construct trimmed-str))))))) - + (let ((result (parse-prefix-suffix-pair construct trimmed-str))) + (if (and (not (variable-p (getf result :value))) + (string= (value (getf result :value)) *rdf-type*)) + (list :next-query (getf result :next-query) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value *type-psi*)) + result)))))))) (defgeneric parse-literal-elem (construct query-string) (:documentation "A helper-function that returns a literal vaue of the form @@ -338,7 +351,7 @@ (:method ((construct SPARQL-Query) (query-string String)) (let* ((trimmed-str (cut-comment query-string)) (delimiters (list "." ";" "}" "<" " " (string #\newline) - (string #\tab) "#")) + (string #\tab))) ; "#")) (end-pos (search-first delimiters trimmed-str)) (elem-str (when end-pos (subseq trimmed-str 0 end-pos))) 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 06:04:00 2011 @@ -1635,7 +1635,7 @@ "SELECT * WHERE { ?subj1 <http://some.where/tmsparql/first-name> \"Johann Wolfgang\". ?subj2 <http://some.where/tmsparql/last-name> 'von Goethe'^^" - *xml-string* ". + *xml-string* ". ?subj3 <http://some.where/tmsparql/date-of-birth> '28.08.1749'^^" *xml-date* ". ?subj4 <http://some.where/tmsparql/date-of-death> '22.03.1832'^^" @@ -1683,5 +1683,31 @@ (is-true (d:get-item-by-psi *rdf-type* :revision 0)))) +(test test-all-2 + "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 pref:<http://www.w3.org/1999/02/> + SELECT * WHERE { + ?subj1 a <http://some.where/tmsparql/author> . + ?subj2 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> <http://some.where/tmsparql/author> . + ?subj3 <http://psi.topicmaps.org/iso13250/model/type> <http://some.where/tmsparql/author> . + ?subj4 pref:22-rdf-syntax-ns#type <http://some.where/tmsparql/author>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 4)) + (map 'list #'(lambda(item) + (cond ((or (string= (getf item :variable) "subj1") + (string= (getf item :variable) "subj2") + (string= (getf item :variable) "subj3") + (string= (getf item :variable) "subj4")) + (is (string= (first (getf item :result)) + "<http://some.where/tmsparql/author/goethe>"))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

isidorus-cvs April 2011