Author: lgiessmann Date: Thu Mar 31 07:34:18 2011 New Revision: 397
Log: tm-sparql: finished all unittests that checks the api's behaviour with different literal datatypes => fixed several bugs that handles xml-boolean, xml-integer, xml-decimal, xml-double, and xml-date values; fixed a bug in the xtm test file; extended the function "literal=" so any objects can be compared to other objects in the string^^datatype format.
Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/TM-SPARQL/tmsparql_core_psis.xtm trunk/src/base-tools/base-tools.lisp trunk/src/constants.lisp trunk/src/isidorus.asd trunk/src/unit_tests/sparql_test.lisp trunk/src/unit_tests/sparql_test.xtm trunk/src/unit_tests/unittests-constants.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Thu Mar 31 07:34:18 2011 @@ -502,7 +502,8 @@
(defun return-characteristics (literal-value literal-datatype) - "Returns all characteristica that own the specified value." + "Returns all characteristica that own the specified value. + 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*) @@ -516,7 +517,8 @@ (elephant:get-instances-by-value 'NameC 'charvalue literal-value)))) ((and (string= literal-datatype *xml-boolean*) - literal-value) + (or (and (stringp literal-value) (string= literal-value "true")) + (and (typep literal-value 'Boolean) literal-value))) (remove-if #'(lambda(elem) (string/= (charvalue elem) "true")) (append (elephant:get-instances-by-value @@ -524,7 +526,8 @@ (elephant:get-instances-by-value 'OccurrenceC 'charvalue "true")))) ((and (string= literal-datatype *xml-boolean*) - (not literal-value)) + (or (and (stringp literal-value) (string= literal-value "false")) + (and (typep literal-value 'Boolean) (not literal-value)))) (remove-if #'(lambda(elem) (string/= (charvalue elem) "false")) (append (elephant:get-instances-by-value @@ -541,9 +544,15 @@ (elephant:get-instances-by-value 'VariantC 'datatype literal-datatype) (elephant:get-instances-by-value - 'OccurrenceC 'datatype literal-datatype))))) + 'OccurrenceC 'datatype literal-datatype)))) + (user-val (if (stringp literal-value) + (concat """"" literal-value """"^^" + literal-datatype) + literal-value))) (remove-if #'(lambda(con) - (not (literal= (charvalue con) literal-value))) + (not (literal= (concat """"" (charvalue con) + """"^^" (datatype con)) + user-val))) constructs)))))) ;;elephant returns names, occurences, and variants if any string ;;value matches, so all duplicates have to be removed @@ -830,24 +839,53 @@ (get-item-by-any-id (value construct) :revision revision)))))
+(defun split-literal-string (literal-string) + "Returns a list of the form (:value literal-value :datatype literal-type) + of a string literal-value^^literal-type." + (when (stringp literal-string) + (let ((str (cut-comment literal-string))) + (when (string-starts-with-one-of literal-string (list """ "'")) + (let* ((delimiter (cond ((string-starts-with str "'") "'") + ((string-starts-with str """"") """"") + (t """))) + (l-end (find-literal-end (subseq str (length delimiter)) delimiter)) + (l-value (subseq str (length delimiter) l-end)) + (l-rest (subseq str (+ (length delimiter) l-end))) + (l-type (if (string-starts-with l-rest "^^") + (subseq l-rest 2) + *xml-string*))) + (list :value l-value :datatype l-type)))))) + + (defun literal= (value-1 value-2) "Returns t if both arguments are equal. The equality function is searched in the table *equal-operators*." - (when (or (and (numberp value-1) (numberp value-2)) - (typep value-1 (type-of value-2)) - (typep value-2 (type-of value-1))) - (let ((operator (get-equal-operator value-1))) - (funcall operator value-1 value-2)))) + (let ((real-value-1 (let ((result (split-literal-string value-1))) + (if result + (cast-literal (getf result :value) + (getf result :datatype)) + value-1))) + (real-value-2 (let ((result (split-literal-string value-2))) + (if result + (cast-literal (getf result :value) + (getf result :datatype)) + value-2)))) + (when (or (and (numberp real-value-1) (numberp real-value-2)) + (typep value-1 (type-of real-value-2)) + (typep value-2 (type-of real-value-1))) + (let ((operator (get-equal-operator real-value-1))) + (funcall operator real-value-1 real-value-2)))))
(defun filter-datatypable-by-value (construct literal-value literal-datatype) "A helper that compares the datatypable's charvalue with the passed literal value." (declare (d::DatatypableC construct) - (type (or Null String) literal-value literal-datatype)) + (type (or Null String) literal-datatype)) (when (or (not literal-datatype) (string= (datatype construct) literal-datatype)) - (if (not literal-value) + (if (and (not literal-value) + (string/= literal-datatype *xml-boolean*)) construct (handler-case (let ((occ-value (cast-literal (charvalue construct) @@ -869,7 +907,7 @@ "A helper that compares the occurrence's charvalue with the passed literal value." (declare (OccurrenceC occurrence) - (type (or Null String) literal-value literal-datatype)) + (type (or Null String) literal-datatype)) (filter-datatypable-by-value occurrence literal-value literal-datatype))
@@ -919,7 +957,8 @@ (by-literal (if literal-value (names-by-value construct #'(lambda(name) - (string= name literal-value)) + (literal= name literal-value)) + ;(string= name literal-value)) :revision revision) (names construct :revision revision))) (all-names (intersection by-type by-literal))
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Thu Mar 31 07:34:18 2011 @@ -288,17 +288,21 @@ (triple-delimiters (list ". " ";" " " (string #\tab) (string #\newline) "}")) - (end-pos (search-first triple-delimiters - trimmed-str))) + (end-pos (search-first triple-delimiters trimmed-str))) (unless end-pos (error (make-sparql-parser-condition trimmed-str (original-query construct) "'. ', , ';' ' ', '\t', '\n' or '}'"))) (let* ((literal-number - (read-from-string (subseq trimmed-str 0 end-pos))) + (read-from-string + (let ((str-value (subseq trimmed-str 0 end-pos))) + (if (string-ends-with str-value ".") + (progn (decf end-pos) + (subseq str-value 0 (1- (length str-value)))) + str-value)))) (number-type (if (search "." (subseq trimmed-str 0 end-pos)) - *xml-double* ;could also be an xml:decimal, since the doucble has + *xml-double* ;could also be an xml:decimal, since the double has ;a bigger range it shouldn't matter *xml-integer*))) (unless (numberp literal-number)
Modified: trunk/src/TM-SPARQL/tmsparql_core_psis.xtm ============================================================================== --- trunk/src/TM-SPARQL/tmsparql_core_psis.xtm (original) +++ trunk/src/TM-SPARQL/tmsparql_core_psis.xtm Thu Mar 31 07:34:18 2011 @@ -42,4 +42,7 @@ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/value"/> </topic>
+ <topic id="rdf-type"> + <subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#type"/> + </topic> </topicMap>
Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Thu Mar 31 07:34:18 2011 @@ -113,20 +113,23 @@
(defun trim-whitespace-left (value) "Uses string-left-trim with a predefined character-list." - (declare (String value)) - (string-left-trim *white-space* value)) + (declare (type (or Null String) value)) + (when value + (string-left-trim *white-space* value)))
(defun trim-whitespace-right (value) "Uses string-right-trim with a predefined character-list." - (declare (String value)) - (string-right-trim *white-space* value)) + (declare (type (or Null String) value)) + (when value + (string-right-trim *white-space* value)))
(defun trim-whitespace (value) "Uses string-trim with a predefined character-list." - (declare (String value)) - (string-trim *white-space* value)) + (declare (type (or Null String) value)) + (when value + (string-trim *white-space* value)))
(defun string-starts-with (str prefix &key (ignore-case nil))
Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Thu Mar 31 07:34:18 2011 @@ -30,6 +30,7 @@ :*xml-decimal* :*xml-double* :*xml-integer* + :*xml-date* :*xml-uri* :*rdf2tm-ns* :*rdf-statement* @@ -109,6 +110,8 @@
(defparameter *xml-integer* "http://www.w3.org/2001/XMLSchema#integer")
+(defparameter *xml-date* "http://www.w3.org/2001/XMLSchema#date") + (defparameter *xml-decimal* "http://www.w3.org/2001/XMLSchema#decimal")
(defparameter *xml-double* "http://www.w3.org/2001/XMLSchema#double")
Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Thu Mar 31 07:34:18 2011 @@ -149,6 +149,7 @@ (:static-file "reification_xtm1.0.xtm") (:static-file "reification_xtm2.0.xtm") (:static-file "reification.rdf") + (:static-file "sparql_test.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm"
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Thu Mar 31 07:34:18 2011 @@ -1625,7 +1625,63 @@ "http://some.where/psis/poem/erlkoenig" "http://some.where/psis/poem/zauberlehrling") :test #'string=)))))) - + + +(test test-all-1 + "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 + "SELECT * WHERE { + ?subj1 http://some.where/tmsparql/first-name "Johann Wolfgang". + ?subj2 http://some.where/tmsparql/last-name 'von Goethe'^^" + *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'^^" + *xml-date* ". + ?subj5 http://some.where/tmsparql/years 82.0. + ?subj6 http://some.where/tmsparql/years 82. + ?subj7 http://some.where/tmsparql/years '82'^^" *xml-integer* ". + ?subj8 http://some.where/tmsparql/isDead true. + ?subj9 http://some.where/tmsparql/isDead 'true'^^" *xml-boolean* ". + ?subj10 http://some.where/tmsparql/isDead 'false'^^" *xml-boolean* ". + ?subj11 http://some.where/tmsparql/isDead false" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 11)) + (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") + (string= (getf item :variable) "subj6") + (string= (getf item :variable) "subj7") + (string= (getf item :variable) "subj8") + (string= (getf item :variable) "subj9")) + (is (string= (first (getf item :result)) + "http://some.where/tmsparql/author/goethe"))) + ((or (string= (getf item :variable) "subj5") + (string= (getf item :variable) "subj10") + (string= (getf item :variable) "subj11")) + (is-false (getf item :result))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/topicProperty" + :revision 0)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/reifier" + :revision 0)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/role" + :revision 0)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/player" + :revision 0)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/scope" + :revision 0)) + (is-true (d:get-item-by-psi "http://www.networkedplanet.com/tmsparql/value" + :revision 0)) + (is-true (d:get-item-by-psi *rdf-type* :revision 0)))) +
(defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test: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 Thu Mar 31 07:34:18 2011 @@ -73,7 +73,7 @@ </tm:topic>
<tm:topic id="last-name"> - <tm:subjectIdentifier href="http://some.where/tmsparql/first-name%22/%3E + <tm:subjectIdentifier href="http://some.where/tmsparql/last-name%22/%3E tm:instanceOf<tm:topicRef href="#nametype"/></tm:instanceOf> </tm:topic>
@@ -117,6 +117,11 @@ tm:instanceOf<tm:topicRef href="#occurrencetype"/></tm:instanceOf> </tm:topic>
+ <tm:topic id="isAlive"> + <tm:subjectIdentifier href="http://some.where/tmsparql/isAlive%22/%3E + tm:instanceOf<tm:topicRef href="#occurrencetype"/></tm:instanceOf> + </tm:topic> + <tm:topic id="reifier-type"> <tm:subjectIdentifier href="http://some.where/tmsparql/reifier-type%22/%3E tm:instanceOf<tm:topicRef href="#topictype"/></tm:instanceOf> @@ -147,19 +152,23 @@ <tm:occurrence reifier="http://some.where/ii/goethe-occ-reifier%22%3E <tm:itemIdentity href="http://some.where/ii/goethe-occ%22/%3E tm:type<tm:topicRef href="#date-of-birth"/></tm:type> - <tm:resourceData href="http://www.w3.org/2001/XMLSchema#date%22%3E28.08.1749</tm:resourceData> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date%22%3E28.08.1749</tm:resourceData> </tm:occurrence> tm:occurrence tm:type<tm:topicRef href="#date-of-death"/></tm:type> - <tm:resourceData href="http://www.w3.org/2001/XMLSchema#integer%22%3E22.03.1832</tm:resourceData> <!-- bad data type --> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date%22%3E22.03.1832</tm:resourceData> </tm:occurrence> tm:occurrence tm:type<tm:topicRef href="#years"/></tm:type> - <tm:resourceData href="http://www.w3.org/2001/XMLSchema#integer%22%3E82</tm:resourceData> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#integer%22%3E82</tm:resourceData> </tm:occurrence> tm:occurrence tm:type<tm:topicRef href="#isDead"/></tm:type> - <tm:resourceData href="http://www.w3.org/2001/XMLSchema#boolean%22%3Etrue</tm:resourceData> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#boolean%22%3Etrue</tm:resourceData> + </tm:occurrence> + tm:occurrence + tm:type<tm:topicRef href="#isAlive"/></tm:type> <!-- redundancy: needed for checking booleans --> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#boolean%22%3Efalse</tm:resourceData> </tm:occurrence> </tm:topic>
Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Thu Mar 31 07:34:18 2011 @@ -30,6 +30,7 @@ :*atom_test.xtm* :*atom-conf.lisp* :*poems.xtm* + :*sparql_test.xtm* :*poems_light.rdf* :*poems_light.xtm* :*poems_light.xtm.txt* @@ -105,6 +106,10 @@ (asdf:component-pathname (asdf:find-component *unit-tests-component* "poems.xtm")))
+(defparameter *sparql_test.xtm* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "sparql_test.xtm"))) + (defparameter *poems_light.rdf* (asdf:component-pathname (asdf:find-component *unit-tests-component* "poems_light.rdf")))