Author: lgiessmann Date: Sat Dec 4 12:07:46 2010 New Revision: 359 Log: TM-SPARQL: added unit-tests for the "result"=>SPARQL-Query method => fixed some bugs Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.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 Sat Dec 4 12:07:46 2010 @@ -132,9 +132,8 @@ ;purposes and mustn't be reset :type List :initform nil - :documentation "A list of the form ((:variable var-name - :value value-object)), that contains tuples - for each selected variable and its result.") + :documentation "A list of the form that contains the variable + names as string.") (prefixes :initarg :prefixes :accessor prefixes ;this value is only for internal purposes ;purposes and mustn't be reset @@ -159,18 +158,23 @@ (:documentation "This class represents the entire request.")) -(defmethod variables ((construct SPARQL-Triple-Elem)) +(defgeneric *-p (construct) + (:documentation "Returns t if the user selected all variables with *.") + (:method ((construct SPARQL-Query)) + (and (= (length (variables construct)) 1) + (string= (first (variables construct)) "*")))) + + +(defmethod variables ((construct SPARQL-Triple)) "Returns all variable names that are contained in the passed element." (remove-duplicates (remove-null - (loop for triple in (select-group construct) - collect (remove-null - (list (when (variable-p (subject construct)) - (value (subject construct))) - (when (variable-p (predicate construct)) - (value (predicate construct))) - (when (variable-p (object construct)) - (value (object construct))))))) + (list (when (variable-p (subject construct)) + (value (subject construct))) + (when (variable-p (predicate construct)) + (value (predicate construct))) + (when (variable-p (object construct)) + (value (object construct))))) :test #'string=)) @@ -222,20 +226,14 @@ (concatenate 'string (getf entry :label) ":")))))) -(defgeneric add-variable (construct variable-name variable-value) +(defgeneric add-variable (construct variable-name) (:documentation "Adds a new variable-name with its value to the aexisting list. If a variable-already exists the existing entry will be overwritten. An entry is of the form (:variable string :value any-type).") - (:method ((construct SPARQL-Query) (variable-name String) variable-value) - (let ((existing-tuple - (find-if #'(lambda(x) - (string= (getf x :variable) variable-name)) - (variables construct)))) - (if existing-tuple - (setf (getf existing-tuple :value) variable-value) - (push (list :variable variable-name :value variable-value) - (variables construct)))))) + (:method ((construct SPARQL-Query) (variable-name String)) + (unless (find variable-name (variables construct) :test #'string=) + (push variable-name (variables construct))))) (defgeneric set-results (construct &key revision) @@ -755,17 +753,20 @@ assocs))))) - (defgeneric result (construct) (:documentation "Returns the result of the entire query.") (:method ((construct SPARQL-Query)) (let ((result-lists (make-result-lists construct))) (reduce-results construct result-lists) - (let* ((response-variables (variables construct)) + (let* ((response-variables + (if (*-p construct) + (all-variables construct) + (variables construct))) (cleaned-results (make-result-lists construct))) (map 'list #'(lambda(response-variable) - (variable-intersection response-variable - cleaned-results)) + (list :variable response-variable + :result (variable-intersection response-variable + cleaned-results))) response-variables))))) @@ -775,28 +776,39 @@ (:method ((construct SPARQL-Query)) (remove-null (loop for triple in (select-group construct) - collect (remove-null - (list - (when (variable-p (subject construct)) - (list :variable (value (subject construct)) - :result (subject-result construct))) - (when (variable-p (predicate construct)) - (list :variable (value (predicate construct)) - :result (predicate-result construct))) - (when (variable-p (object construct)) - (list :variable (value (object construct)) - :result (object-result construct))))))))) + append (remove-null + (list + (when (variable-p (subject triple)) + (list :variable (value (subject triple)) + :result (subject-result triple))) + (when (variable-p (predicate triple)) + (list :variable (value (predicate triple)) + :result (predicate-result triple))) + (when (variable-p (object triple)) + (list :variable (value (object triple)) + :result (object-result triple))))))))) (defgeneric all-variables (result-lists) (:documentation "Returns a list of all variables that are contained in - the passed result-lists.") - (:method ((result-lists List)) - (remove-duplicates - (map 'list #'(lambda(entry) - (getf entry :variable)) - result-lists) - :test #'string=))) + the passed result-lists.")) + + +(defmethod all-variables ((result-lists List)) + (remove-duplicates + (map 'list #'(lambda(entry) + (getf entry :variable)) + result-lists) + :test #'string=)) + + +(defmethod all-variables ((construct SPARQL-Query)) + "Returns all variables that are contained in the select groupt memebers." + (remove-duplicates + (remove-null + (loop for triple in (select-group construct) + append (variables triple))) + :test #'string=)) (defgeneric variable-intersection (variable-name result-lists) @@ -814,7 +826,7 @@ (recursive-intersection list-1 list-2 more-lists)))) -(defun recursive-intersection (list-1 list-2 &rest more-lists) +(defun recursive-intersection (list-1 list-2 more-lists) "Returns an intersection of al the passed lists." (declare (List list-1 list-2)) (let ((current-result @@ -823,10 +835,10 @@ (if (and (stringp val-1) (stringp val-2)) (string= val-1 val-2) (eql val-1 val-2)))))) - (if (= (length more-lists) 0) + (if (not more-lists) current-result - (apply #'recursive-intersection current-result - (first more-lists) (rest more-lists))))) + (recursive-intersection current-result (first more-lists) + (rest more-lists))))) (defgeneric reduce-results(construct result-lists) @@ -841,7 +853,7 @@ (defgeneric reduce-triple(construct result-lists) (:documentation "Reduces the results of a triple by using only the intersection values.") - (:method ((construct SPARQL-Triple-Elem) (result-lists List)) + (:method ((construct SPARQL-Triple) (result-lists List)) (let* ((triple-variables (variables construct)) (intersections (map 'list #'(lambda(var) @@ -859,7 +871,7 @@ (:documentation "Checks all results of the passed variable of the given construct and deletes every result with the corresponding row that is not contained in the dont-touch-values.") - (:method ((construct SPARQL-Triple-Elem) (variable-name String) + (:method ((construct SPARQL-Triple) (variable-name String) (dont-touch-values List)) (let ((var-elem (cond ((and (variable-p (subject construct)) @@ -871,29 +883,30 @@ ((and (variable-p (object construct)) (string= (value (object construct)) variable-name)) (object-result construct))))) - (if (not var-elem) - construct - (let* ((rows-to-hold - (remove-null - (map 'list #'(lambda(val) - (if (stringp val) - (position val var-elem :test #'string=) - (position val var-elem))) - var-elem))) - (new-result-list - (dolist (row-idx rows-to-hold) - (list :subject (elt (subject-result construct) row-idx) - :predicate (elt (predicate-result construct) row-idx) - :object (elt (object-result construct) row-idx))))) - (setf (subject-result construct) - (map 'list #'(lambda(entry) - (getf entry :subject)) new-result-list)) - (setf (predicate-result construct) - (map 'list #'(lambda(entry) - (getf entry :predicate)) new-result-list)) - (setf (object-result construct) - (map 'list #'(lambda(entry) - (getf entry :object)) new-result-list))))))) + (when var-elem + (let* ((rows-to-hold + (remove-null + (map 'list #'(lambda(val) + (if (stringp val) + (position val var-elem :test #'string=) + (position val var-elem))) + dont-touch-values))) + (new-result-list + (map 'list + #'(lambda(row-idx) + (list :subject (elt (subject-result construct) row-idx) + :predicate (elt (predicate-result construct) row-idx) + :object (elt (object-result construct) row-idx))) + rows-to-hold))) + (setf (subject-result construct) + (map 'list #'(lambda(entry) + (getf entry :subject)) new-result-list)) + (setf (predicate-result construct) + (map 'list #'(lambda(entry) + (getf entry :predicate)) new-result-list)) + (setf (object-result construct) + (map 'list #'(lambda(entry) + (getf entry :object)) new-result-list))))))) (defgeneric results-for-variable (variable-name result-lists) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sat Dec 4 12:07:46 2010 @@ -163,7 +163,7 @@ (list :next-query (cut-comment (subseq trimmed-str 1)) :value (make-instance 'SPARQL-Triple-Elem :elem-type 'IRI - :value *rdf-type*))) + :value *type-psi*))) ((string-starts-with trimmed-str "<") (parse-base-suffix-pair trimmed-str query-object)) ((or (string-starts-with trimmed-str "?") @@ -484,10 +484,10 @@ (if (string-starts-with trimmed-str "WHERE") trimmed-str (if (string-starts-with trimmed-str "*") - (progn (add-variable construct "*" nil) + (progn (add-variable construct "*") (parse-variables construct (string-after trimmed-str "*"))) (let ((result (parse-variable-name trimmed-str construct))) - (add-variable construct (getf result :value) nil) + (add-variable construct (getf result :value)) (parse-variables construct (getf result :next-query)))))))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sat Dec 4 12:07:46 2010 @@ -28,7 +28,8 @@ :test-set-result-2 :test-set-result-3 :test-set-result-4 - :test-set-result-5)) + :test-set-result-5 + :test-result)) (in-package :sparql-test) @@ -134,35 +135,22 @@ (is-true query-object-3) (signals sparql-parser-error (make-instance 'SPARQL-Query :query query-3)) (is (= (length (TM-SPARQL::variables query-object-1)) 3)) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var1") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-1))) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var2") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-1))) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var3") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-1))) + (is-true (find "var1" (TM-SPARQL::variables query-object-1) + :test #'string=)) + (is-true (find "var2" (TM-SPARQL::variables query-object-1) + :test #'string=)) + (is-true (find "var3" (TM-SPARQL::variables query-object-1) + :test #'string=)) (is (= (length (TM-SPARQL::variables query-object-2)) 3)) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var1") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-2))) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var2") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-2))) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "var3") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-2))) - (is-true (find-if #'(lambda(elem) - (and (string= (getf elem :variable) "*") - (null (getf elem :value)))) - (TM-SPARQL::variables query-object-3))))) + (is-true (find "var1" (TM-SPARQL::variables query-object-2) + :test #'string=)) + (is-true (find "var2" (TM-SPARQL::variables query-object-2) + :test #'string=)) + (is-true (find "var3" (TM-SPARQL::variables query-object-2) + :test #'string=)) + (is-true (find "*" (TM-SPARQL::variables query-object-3) + :test #'string=)) + (is-true (tm-sparql::*-p query-object-3)))) (test test-parse-literals @@ -940,5 +928,117 @@ (second (tm-sparql::select-group q-obj-3)))))))))) +(test test-result + (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) + (with-revision 0 + (let* ((query-1 "PREFIX author:<http://some.where/psis/author/> + PREFIX poem:<http://some.where/psis/poem/> + PREFIX basePSIs:<http://some.where/base-psis/> + SELECT ?poems ?poets WHERE { + ?poets a basePSIs:author . + ?poets basePSIs:written ?poems. + ?poems basePSIs:title 'Der Erlkönig' . + ?poems a basePSIs:poem}") + (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) + (query-2 "PREFIX author:<http://some.where/psis/author/> + PREFIX poem:<http://some.where/psis/poem/> + PREFIX basePSIs:<http://some.where/base-psis/> + SELECT * WHERE { + ?poems a basePSIs:poem. + <goethe> <last-name> 'von Goethe' . + ?poems basePSIs:title ?titles}") + (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))) + (is-true q-obj-1) + (is-true q-obj-2) + (is (= (length (tm-sparql::select-group q-obj-1)) 4)) + (is (= (length (tm-sparql::select-group q-obj-2)) 3)) + (is (= (length (result q-obj-1)) 2)) + (if (string= (getf (first (result q-obj-1)) :variable) "poets") + (progn + (is (= (length (getf (first (result q-obj-1)) :result)) 1)) + (is (or (string= (first (getf (first (result q-obj-1)) :result)) + "http://some.where/psis/author/goethe") + (string= (first (getf (first (result q-obj-1)) :result)) + "http://some.where/psis/persons/goethe"))) + (is (= (length (getf (second (result q-obj-1)) :result)) 1)) + (is (string= (first (getf (second (result q-obj-1)) :result)) + "http://some.where/psis/poem/erlkoenig")) + (is (string= (getf (second (result q-obj-1)) :variable) "poems"))) + (progn + (is (= (length (getf (second (result q-obj-1)) :result)) 1)) + (is (or (string= (first (getf (second (result q-obj-1)) :result)) + "http://some.where/psis/author/goethe") + (string= (first (getf (second (result q-obj-1)) :result)) + "http://some.where/psis/persons/goethe"))) + (is (= (length (getf (first (result q-obj-1)) :result)) 1)) + (is (string= (first (getf (first (result q-obj-1)) :result)) + "http://some.where/psis/poem/erlkoenig")) + (is (string= (getf (first (result q-obj-1)) :variable) "poems")))) + (is (= (length (result q-obj-2)) 2)) + (if (string= (getf (first (result q-obj-2)) :variable) "titles") + (progn + (is (= (length (getf (first (result q-obj-2)) :result)) 4)) + (is-true + (find "Mondnacht" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Der Erlkönig" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Der Zauberlehrling" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Resignation - Eine Phantasie" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (string= (getf (second (result q-obj-2)) :variable) "poems") + (is-true + (find "http://some.where/psis/poem/mondnacht" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "http://some.where/psis/poem/resignation" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "http://some.where/psis/poem/erlkoenig" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (or + (find "http://some.where/psis/poem/zauberlehrling" + (getf (second (result q-obj-2)) :result) :test #'string=) + (find "http://some.where/psis/poem/der_zauberlehrling" + (getf (second (result q-obj-2)) :result) :test #'string=)))) + (progn + (is (= (length (getf (second (result q-obj-2)) :result)) 4)) + (is-true + (find "Mondnacht" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Der Erlkönig" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Der Zauberlehrling" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "Resignation - Eine Phantasie" + (getf (second (result q-obj-2)) :result) :test #'string=)) + (string= (getf (first (result q-obj-2)) :variable) "poems") + (is-true + (find "http://some.where/psis/poem/mondnacht" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "http://some.where/psis/poem/resignation" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (find "http://some.where/psis/poem/erlkoenig" + (getf (first (result q-obj-2)) :result) :test #'string=)) + (is-true + (or + (find "http://some.where/psis/poem/zauberlehrling" + (getf (first (result q-obj-2)) :result) :test #'string=) + (find "http://some.where/psis/poem/der_zauberlehrling" + (getf (first (result q-obj-2)) :result) :test #'string=))))))))) + + + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))