[isidorus-cvs] r404 - in trunk/src: TM-SPARQL unit_tests

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Apr  1 09:57:58 2011
New Revision: 404

Log:
TM-SPARQL: finsihed the unit-tests for the special-uri tms:value => fixed a bug when '<date>'^^xml-date is given

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_special_uris.lisp
   trunk/src/unit_tests/sparql_test.lisp
   trunk/src/unit_tests/sparql_test.xtm

Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql.lisp	Fri Apr  1 09:57:58 2011
@@ -505,7 +505,8 @@
    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*)
+	 (cond ((or (string= literal-datatype *xml-string*)
+		    (string= literal-datatype *xml-date*))
 		(remove-if #'(lambda(elem)
 			       (string/= (charvalue elem) literal-value))
 			   (append

Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp	Fri Apr  1 09:57:58 2011
@@ -255,7 +255,7 @@
 		    (not (variable-p obj)))
 	       (when (or (and (typep subj 'NameC)
 			      (string= literal-datatype *xml-string*)
-			      (string= (charvalue subj) (value obj)))
+			      (string= (charvalue (value subj)) (value obj)))
 			 (filter-datatypable-by-value subj obj literal-datatype))
 		 (list (list :subject subj-uri
 			     :predicate pred-uri
@@ -264,10 +264,10 @@
 	      ((not (variable-p subj))
 	       (list (list :subject subj-uri
 			   :predicate pred-uri
-			   :object (charvalue subj)
-			   :literal-datatype (if (typep subj 'd:NameC)
+			   :object (charvalue (value subj))
+			   :literal-datatype (if (typep (value subj) 'd:NameC)
 						 *xml-string*
-						 (datatype subj)))))
+						 (datatype (value subj))))))
 	      ((not (variable-p obj))
 	       (loop for char in (return-characteristics (value obj) literal-datatype)
 		  collect (list :subject (sparql-node char :revision revision)

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Fri Apr  1 09:57:58 2011
@@ -1882,12 +1882,55 @@
 	   r-1))))
 
 
+(test test-all-8
+  "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
+		 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
+                  SELECT * WHERE {
+                   <http://some.where/ii/goethe-untyped-name> tms:value ?obj1.
+                   <http://some.where/ii/goethe-occ> tms:value ?obj2.
+                   <http://some.where/ii/goethe-variant> tms:value ?obj3.
+                   ?subj1 tms:value 'Goethe'.
+                   ?subj2 tms:value '28.08.1749'^^http://www.w3.org/2001/XMLSchema#date.
+                   ?subj3 tms:value 'Johann Wolfgang von Goethe'.
+                   ?subj4 tms:value 82"
+                 "}"))
+	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
+      (is-true (= (length r-1) 7))
+      (map 'list #'(lambda(item)
+		     (cond ((string= (getf item :variable) "obj1")
+			    (is (string= (first (getf item :result))
+					 "Johann Wolfgang von Goethe")))
+			   ((string= (getf item :variable) "obj2")
+			    (is (string= (first (getf item :result))
+					 "28.08.1749")))
+			   ((string= (getf item :variable) "obj3")
+			    (is (string= (first (getf item :result))
+					 "Goethe")))
+			   ((string= (getf item :variable) "subj1")
+			    (is (string= (first (getf item :result))
+					 "<http://some.where/ii/goethe-variant>")))
+			   ((string= (getf item :variable) "subj2")
+			    (is (string= (first (getf item :result))
+					 "<http://some.where/ii/goethe-occ>")))
+			   ((string= (getf item :variable) "subj3")
+			    (is (string= (first (getf item :result))
+					 "<http://some.where/ii/goethe-untyped-name>")))
+			   ((string= (getf item :variable) "subj4")
+			    (is (string= (first (getf item :result))
+					 "<http://some.where/ii/goethe-years-occ>")))
+			   (t
+			    (is-true (format t "bad variable-name found")))))
+	   r-1))))
+
 
 
-;TODO: tms:scope, tms:value, complex filter
-;      <obj> <pred> <subj>
-;      ?obj <pred> ?subj
-;      <subj> ?pred ?obj
+;TODO: tms:value, complex filter,
+;      <obj> <pred> <subj>,
+;      ?obj <pred> ?subj,
+;      <subj> ?pred ?obj,
 ;      ?subj ?pred <obj>
 ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
 ;      SELECT * WHERE {

Modified: trunk/src/unit_tests/sparql_test.xtm
==============================================================================
--- trunk/src/unit_tests/sparql_test.xtm	(original)
+++ trunk/src/unit_tests/sparql_test.xtm	Fri Apr  1 09:57:58 2011
@@ -141,6 +141,7 @@
       <tm:type><tm:topicRef href="#last-name"/></tm:type>
       <tm:value>von Goethe</tm:value>
       <tm:variant>
+	<tm:itemIdentity href="http://some.where/ii/goethe-variant"/>
 	<tm:scope><tm:topicRef href="#display-name"/></tm:scope>
 	<tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Goethe</tm:resourceData>
       </tm:variant>
@@ -159,6 +160,7 @@
       <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData>
     </tm:occurrence>
     <tm:occurrence>
+      <tm:itemIdentity href="http://some.where/ii/goethe-years-occ"/>
       <tm:type><tm:topicRef href="#years"/></tm:type>
       <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#integer">82</tm:resourceData>
     </tm:occurrence>