[isidorus-cvs] r397 - in trunk/src: . TM-SPARQL base-tools unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Thu Mar 31 11:34:18 UTC 2011


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"/>
+    <tm:subjectIdentifier href="http://some.where/tmsparql/last-name"/>
     <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"/>
+    <tm:instanceOf><tm:topicRef href="#occurrencetype"/></tm:instanceOf>
+  </tm:topic>
+
   <tm:topic id="reifier-type">
     <tm:subjectIdentifier href="http://some.where/tmsparql/reifier-type"/>
     <tm:instanceOf><tm:topicRef href="#topictype"/></tm:instanceOf>
@@ -147,19 +152,23 @@
     <tm:occurrence reifier="http://some.where/ii/goethe-occ-reifier">
       <tm:itemIdentity href="http://some.where/ii/goethe-occ"/>
       <tm:type><tm:topicRef href="#date-of-birth"/></tm:type>
-      <tm:resourceData href="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.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.03.1832</tm:resourceData> <!-- bad data type -->
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.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">82</tm:resourceData>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#integer">82</tm:resourceData>
     </tm:occurrence>
     <tm:occurrence>
       <tm:type><tm:topicRef href="#isDead"/></tm:type>
-      <tm:resourceData href="http://www.w3.org/2001/XMLSchema#boolean">true</tm:resourceData>
+      <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#boolean">true</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">false</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")))




More information about the Isidorus-cvs mailing list