Author: lgiessmann Date: Sun Nov 28 14:47:27 2010 New Revision: 356 Log: TM-SPARQL: added some unit-tests for processing single triples in a SELECT-WHERE statement => fixed some bugs in the SPARQL-queries Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/poems.xtm 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 Nov 28 14:47:27 2010 @@ -114,7 +114,13 @@ (defclass SPARQL-Query () - ((original-query :initarg :query + ((revision :initarg :revision + :accessor revision + :type Integer + :initform 0 + :documentation "Represents the revision in which all the queries + are processed in the DB.") + (original-query :initarg :query :accessor original-query ;this value is only for internal ;purposes and mustn't be reset :type String @@ -230,9 +236,9 @@ (filter-by-given-predicate construct :revision revision) (filter-by-given-object construct :revision revision)))) (map 'list #'(lambda(result) - (push (getf result :subject) (subject construct)) - (push (getf result :predicate) (predicate construct)) - (push (getf result :object) (object construct))) + (push (getf result :subject) (subject-result construct)) + (push (getf result :predicate) (predicate-result construct)) + (push (getf result :object) (object-result construct))) ;;literal-datatype is not used and is not returned, since ;;the values are returned as object of their specific type, e.g. ;;integer, boolean, string, ... @@ -244,7 +250,9 @@ of a given object.") (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) (declare (Integer revision)) - (unless (variable-p (object construct)) + (when (and (not (variable-p (object construct))) + (variable-p (predicate construct)) + (variable-p (subject construct))) (cond ((literal-p (object construct)) (filter-by-characteristic-value (value (object construct)) (literal-datatype (object construct)) @@ -304,7 +312,12 @@ :predicate pred :object (charvalue char) :literal-datatyp literal-datatype)))) - chars)))) + ;;elephant returns names, occurences, and variants if any string + ;;value matches, so all duplicates have to be removed, additionaly + ;;variants have to be remove completely + (remove-if #'(lambda(obj) + (typep obj 'VariantC)) + (remove-duplicates chars)))))) (defgeneric filter-by-otherplayer (construct &key revision) @@ -328,7 +341,7 @@ (when-do type (instance-of role :revision revision) (any-id type :revision revision))) (subj-uri - (when-do plr (instance-of orole :revision revision) + (when-do plr (player orole :revision revision) (any-id plr :revision revision)))) (when (and obj-uri pred-uri subj-uri) (list :subject subj-uri @@ -364,16 +377,18 @@ (when (or (variable-p (object construct)) (iri-p (object construct))) (let* ((roles-by-type - (map 'list #'(lambda(typed-construct) - (when (typep typed-construct 'RoleC) - typed-construct)) - (used-as-type construct :revision revision))) + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'RoleC) + typed-construct)) + (used-as-type (value (predicate construct)) :revision revision)))) (roles-by-player (if (iri-p (object construct)) (remove-null (map 'list #'(lambda(role) - (when (eql (instance-of role :revision revision) - (value (object construct))))) + (when (eql (player role :revision revision) + (value (object construct))) + role)) roles-by-type)) roles-by-type)) (pred-uri (any-id (value (predicate construct)) :revision revision))) @@ -415,7 +430,7 @@ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) (declare (Integer revision)) (when (and (not (iri-p (object construct))) - (or (not (literal-datatype construct)) + (or (not (literal-datatype (object construct))) (string= (literal-datatype construct) *xml-string*))) (let* ((names-by-type (remove-null @@ -426,12 +441,13 @@ :revision revision)))) (names-by-literal (if (variable-p (object construct)) + names-by-type (remove-null (map 'list #'(lambda(name) - (string= (charvalue name) - (value (object construct)))) - names-by-type)) - names-by-type))) + (when (string= (charvalue name) + (value (object construct))) + name)) + names-by-type))))) (remove-null (map 'list #'(lambda(name) @@ -713,4 +729,6 @@ (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct)) + (dolist (triple (select-group construct)) + (set-results triple :revision (revision construct))) construct) \ No newline at end of file Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sun Nov 28 14:47:27 2010 @@ -208,11 +208,12 @@ ((string-starts-with-digit trimmed-str) (parse-literal-number-value trimmed-str query-object))))) (list :next-query (getf value-type-lang-query :next-query) - :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'LITERAL - :value (getf value-type-lang-query :value) - :literal-lang (getf value-type-lang-query :lang) - :literal-type (getf value-type-lang-query :type))))) + :value (make-instance + 'SPARQL-Triple-Elem + :elem-type 'LITERAL + :value (getf value-type-lang-query :value) + :literal-lang (getf value-type-lang-query :lang) + :literal-datatype (getf value-type-lang-query :type))))) (defun parse-literal-string-value (query-string query-object) Modified: trunk/src/unit_tests/poems.xtm ============================================================================== --- trunk/src/unit_tests/poems.xtm (original) +++ trunk/src/unit_tests/poems.xtm Sun Nov 28 14:47:27 2010 @@ -1,16 +1,16 @@ <?xml version="1.0" encoding="UTF-8"?> <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> - <!-- ======================================================================= --> - <!-- Isidorus --> - <!-- (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff --> - <!-- --> - <!-- Isidorus is freely distributable under the LLGPL license. --> - <!-- This ajax module uses the frameworks PrototypeJs and Scriptaculous, --> - <!-- both are distributed under the MIT license. --> - <!-- You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, --> - <!-- trunk/docs/LGPL-LICENSE.txt and in --> - <!-- trunk/src/ajax/javascripts/external/MIT-LICENSE.txt. --> - <!-- ======================================================================= --> + <!-- ===================================================================== --> + <!-- Isidorus --> + <!-- (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff --> + <!-- --> + <!-- Isidorus is freely distributable under the LLGPL license. --> + <!-- This ajax module uses the frameworks PrototypeJs and Scriptaculous, --> + <!-- both are distributed under the MIT license. --> + <!-- You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, --> + <!-- trunk/docs/LGPL-LICENSE.txt and in --> + <!-- trunk/src/ajax/javascripts/external/MIT-LICENSE.txt. --> + <!-- ===================================================================== --> <!-- ===================================================================== --> <!-- === TMCL meta-model topics ========================================== --> <!-- ===================================================================== --> Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Nov 28 14:47:27 2010 @@ -12,6 +12,9 @@ :it.bese.FiveAM :TM-SPARQL :exceptions + :unittests-constants + :fixtures + :d :constants) (:export :run-sparql-tests :sparql-tests @@ -19,7 +22,9 @@ :test-parse-literals :test-parse-triple-elem :test-parse-group-1 - :test-parse-group-2)) + :test-parse-group-2 + :test-set-result-1 + :test-set-result-2)) (in-package :sparql-test) @@ -408,5 +413,254 @@ (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))))) +(test test-set-result-1 + (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) + (with-revision 0 + (let* ((query-1 "BASE <http://some.where/> + SELECT ?subject ?predicate ?object WHERE { + ?subject ?predicate ?object }") + (query-2 "BASE <http://some.where/psis/poem/> + SELECT $subject ?predicate WHERE{ + ?subject $predicate <zauberlehrling> }") + (query-3 "SELECT ?predicate ?subject WHERE + {?subject ?predicate \"Johann Wolfgang\" }") + (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) + (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)) + (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))) + (is-true q-obj-1) + (is (= (length (tm-sparql::select-group q-obj-1)) 1)) + (is-true q-obj-2) + (is (= (length (tm-sparql::select-group q-obj-2)) 1)) + (is-true q-obj-3) + (is (= (length (tm-sparql::select-group q-obj-3)) 1)) + (is-false (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1)))) + (is-false (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1)))) + (is-false (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1)))) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (let ((subj-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (subj-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (pred-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (pred-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (obj-1 (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2))))) + (obj-2 (second (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))))) + (cond ((or (string= subj-1 "http://some.where/psis/author/goethe") + (string= subj-1 "http://some.where/psis/persons/goethe")) + (is (string= pred-1 "http://some.where/base-psis/written")) + (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") + (string= obj-1 "http://some.where/psis/der_zauberlehrling"))) + (is (string= subj-2 "http://some.where/base-psis/poem")) + (is (string= pred-2 "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")))) + ((string= subj-1 "http://some.where/base-psis/poem") + (is (string= pred-2 "http://some.where/base-psis/written")) + (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") + (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 (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling") + (string= obj-2 "http://some.where/psis/der_zauberlehrling")))) + (t + (is-true nil)))) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (or (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/author/goethe") + (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/persons/goethe"))) + (is (string= (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/base-psis/first-name")) + (is (string= (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) + "Johann Wolfgang")))))) + + +(test test-set-result-2 + (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) + (with-revision 0 + (let* ((query-1 "PREFIX pref:<http://some.where/base-psis/> + SELECT $subject $object WHERE { + ?subject pref:written ?object }") + (query-2 "BASE <http://some.where/base-psis/> + SELECT $subject $object WHERE { + ?subject <first-name> ?object }") + (query-3 "BASE <http://some.where/psis/> + SELECT ?subject WHERE{ + ?subject <http://some.where/base-psis/written> + <poem/zauberlehrling>}") + (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) + (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)) + (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))) + (is-true q-obj-1) + (is (= (length (tm-sparql::select-group q-obj-1)) 1)) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (let* ((s-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-3 (third (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-4 (fourth (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (p-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-3 (third (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-4 (fourth (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (o-1 (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1))))) + (o-2 (second (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1))))) + (o-3 (third (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1))))) + (o-4 (fourth (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1)))))) + (is (string= p-1 "http://some.where/base-psis/written")) + (is (string= p-2 "http://some.where/base-psis/written")) + (is (string= p-3 "http://some.where/base-psis/written")) + (is (string= p-4 "http://some.where/base-psis/written")) + (is (or (not (set-exclusive-or + (list "http://some.where/psis/author/eichendorff" + "http://some.where/psis/author/schiller" + "http://some.where/psis/author/goethe") + (list s-1 s-2 s-3 s-4) + :test #'string=)) + (not (set-exclusive-or + (list "http://some.where/psis/author/eichendorff" + "http://some.where/psis/author/schiller" + "http://some.where/psis/persons/goethe") + (list s-1 s-2 s-3 s-4) + :test #'string=)))) + (is-false (set-exclusive-or + (list "http://some.where/psis/poem/mondnacht" + "http://some.where/psis/poem/resignation" + "http://some.where/psis/poem/erlkoenig" + "http://some.where/psis/poem/zauberlehrling") + (list o-1 o-2 o-3 o-4) + :test #'string=))) + (is-true q-obj-2) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (let* ((s-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (s-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (s-3 (third (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (p-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (p-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (p-3 (third (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (o-1 (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2))))) + (o-2 (second (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2))))) + (o-3 (third (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))))) + (string= p-1 "http://some.where/base-psis/first-name") + (string= p-2 "http://some.where/base-psis/first-name") + (string= p-3 "http://some.where/base-psis/first-name") + (cond ((string= o-1 "Johann Christoph Friedrich") + (is (string= s-1 "http://some.where/psis/author/schiller")) + (cond ((string= o-2 "Johann Wolfgang") + (is (or (string= s-2 "http://some.where/psis/author/goethe") + (string= s-2 "http://some.where/psis/persons/goethe"))) + (is (string= s-3 "http://some.where/psis/author/eichendorff")) + (is (string= o-3 "Joseph Karl Benedikt"))) + ((string= o-2 "Joseph Karl Benedikt") + (is (string= s-2 "http://some.where/psis/author/eichendorff")) + (is (or (string= s-3 "http://some.where/psis/author/goethe") + (string= s-3 "http://some.where/psis/persons/goethe"))) + (is (string= o-3 "Johann Wolfgang"))) + (t + (is-true nil)))) + ((string= o-1 "Johann Wolfgang") + (is (or (string= s-1 "http://some.where/psis/author/goethe") + (string= s-1 "http://some.where/psis/persons/goethe"))) + (cond ((string= o-2 "Johann Christoph Friedrich") + (is (string= s-2 "http://some.where/psis/author/schiller")) + (is (string= s-3 "http://some.where/psis/author/eichendorff")) + (is (string= o-3 "Joseph Karl Benedikt"))) + ((string= o-2 "Joseph Karl Benedikt") + (is (string= s-2 "http://some.where/psis/author/eichendorff")) + (is (string= s-3 "http://some.where/psis/author/schiller")) + (is (string= o-3 "Johann Christoph Friedrich"))) + (t + (is-true nil)))) + ((string= o-1 "Joseph Karl Benedikt") + (is (string= s-1 "http://some.where/psis/author/eichendorff")) + (cond ((string= o-2 "Johann Wolfgang") + (is (or (string= s-2 "http://some.where/psis/author/goethe") + (string= s-2 "http://some.where/psis/persons/goethe"))) + (is (string= s-3 "http://some.where/psis/author/schiller")) + (is (string= o-3 "Johann Christoph Friedrich"))) + ((string= o-2 "Johann Christoph Friedrich") + (is (string= s-2 "http://some.where/psis/author/schiller")) + (is (or (string= s-3 "http://some.where/psis/author/goethe") + (string= s-3 "http://some.where/psis/persons/goethe"))) + (is (string= o-3 "Johann Wolfgang"))) + (t + (is-true nil)))) + (t + (is-true nil)))) + (is-true q-obj-3) + (is (= (length (tm-sparql::select-group q-obj-3)) 1)) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (or (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/author/goethe") + (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/persons/goethe"))) + (is (string= (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/base-psis/written")) + (is (string= (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/poem/zauberlehrling")))))) + + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))