[isidorus-cvs] r359 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Dec 4 17:07:46 UTC 2010
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))
More information about the Isidorus-cvs
mailing list