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

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Apr  1 10:40:07 2011
New Revision: 405

Log:
TM-SPARQL: finsihed the unit-tests for the special-uri of the form <subj> <pred> <obj> => fixed a bug with names playing the role of object-resources

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_special_uris.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	Fri Apr  1 10:40:07 2011
@@ -780,7 +780,9 @@
 		  subj pred (value (object construct))
 		  (literal-datatype (object construct)) :revision revision)))
 	      ((and (iri-p (object construct))
-		    (typep subj 'TopicC))
+		    (typep subj 'TopicC)
+		    (or (variable-p (object construct))
+			(typep (value (object construct)) 'TopicC)))
 	       (filter-associations subj pred (value (object construct))
 				    :revision revision)))))))
 

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 10:40:07 2011
@@ -253,14 +253,19 @@
 		     (literal-p obj)))
 	(cond ((and (not (variable-p subj))
 		    (not (variable-p obj)))
-	       (when (or (and (typep subj 'NameC)
-			      (string= literal-datatype *xml-string*)
+	       (if (typep (value subj) 'NameC)
+		   (when (and (string= literal-datatype *xml-string*)
 			      (string= (charvalue (value subj)) (value obj)))
-			 (filter-datatypable-by-value subj obj literal-datatype))
-		 (list (list :subject subj-uri
-			     :predicate pred-uri
-			     :object (value obj)
-			     :literal-datatype literal-datatype))))
+		     (list (list :subject subj-uri
+				 :predicate pred-uri
+				 :object (value obj)
+				 :literal-datatype literal-datatype)))
+		   (when (filter-datatypable-by-value (value subj) (value obj)
+						      literal-datatype)
+		     (list (list :subject subj-uri
+				 :predicate pred-uri
+				 :object (value obj)
+				 :literal-datatype literal-datatype)))))
 	      ((not (variable-p subj))
 	       (list (list :subject subj-uri
 			   :predicate pred-uri

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 10:40:07 2011
@@ -1926,9 +1926,28 @@
 	   r-1))))
 
 
+(test test-all-9
+  "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/tmsparql/author/goethe> a <http://some.where/tmsparql/author>.
+	           <http://some.where/ii/goethe-occ> tms:reifier <http://some.where/ii/goethe-occ-reifier>.
+                   <http://some.where/ii/association> tms:role <http://some.where/ii/role-2>.
+                   <http://some.where/ii/role-2> tms:player <http://some.where/psis/poem/zauberlehrling>.
+                   <http://some.where/tmsparql/author/goethe> tms:topicProperty <http://some.where/ii/goethe-untyped-name>.
+                   <http://some.where/ii/goethe-variant> tms:scope <http://some.where/tmsparql/display-name>.
+                   <http://some.where/ii/goethe-untyped-name> tms:value 'Johann Wolfgang von Goethe'"
+                 "}"))
+	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
+      (is-false r-1))))
 
-;TODO: tms:value, complex filter,
-;      <obj> <pred> <subj>,
+
+
+
+;TODO: complex filter,
 ;      ?obj <pred> ?subj,
 ;      <subj> ?pred ?obj,
 ;      ?subj ?pred <obj>