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

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Apr  1 08:50:49 2011
New Revision: 400

Log:
TM-SPARQL: finsihed the unit-tests for the special-uri tms:role => fixed a bug when the object is a resource and not a variable

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 08:50:49 2011
@@ -16,10 +16,9 @@
 	   :init-tm-sparql))
 
 
-
 (in-package :TM-SPARQL)
 
-(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels")
+(defvar *empty-label* "_empty_label_symbol" "A label symbol for empyt prefix labels")
 
 (defvar *equal-operators* nil "A Table taht contains tuples of 
                                classes and equality operators.")
@@ -779,7 +778,8 @@
 		 (filter-characteristics
 		  subj pred (value (object construct))
 		  (literal-datatype (object construct)) :revision revision)))
-	      ((iri-p (object construct))
+	      ((and (iri-p (object construct))
+		    (typep subj '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 08:50:49 2011
@@ -151,7 +151,7 @@
 	(when (and (or (variable-p subj)
 		       (typep (value subj) 'd:AssociationC))
 		   (or (variable-p obj)
-		       (typep (value subj) 'd:RoleC)))
+		       (typep (value obj) 'd:RoleC)))
 	  (cond ((and (not (variable-p subj))
 		      (not (variable-p obj)))
 		 (when (find obj (roles (value subj) :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 08:50:49 2011
@@ -1744,12 +1744,59 @@
     (let* ((q-1 (concat
 		 "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
                   SELECT * WHERE {
-                   <http://some.where/ii/goethe-occ> tms:reifier ?obj1.
-                   ?subj1 tms:reifier <http://some.where/ii/goethe-name-reifier>"
+                   ?assoc tms:reifier <http://some.where/ii/association-reifier>.
+                   <http://some.where/ii/association> tms:role ?roles.
+                   ?assoc2 tms:role <http://some.where/ii/role-2>"
                  "}"))
-	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
-      (is-true (= (length r-1) 2))
-      )))
+	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
+	   (role-1 (concat "_:r" (write-to-string
+				  (elephant::oid
+				   (first (roles
+					   (get-item-by-item-identifier 
+					    "http://some.where/ii/association"
+					    :revision 0)))))))
+	   (role-2 (concat "_:r" (write-to-string
+				  (elephant::oid
+				   (second (roles
+					    (get-item-by-item-identifier 
+					     "http://some.where/ii/association"
+					     :revision 0))))))))
+      (is-true (= (length r-1) 3))
+      (map 'list #'(lambda(item)
+		     (cond ((string= (getf item :variable) "assoc")
+			    (is (string= (first (getf item :result))
+					 "<http://some.where/ii/association>")))
+			    ((string= (getf item :variable) "roles")
+			    (is (or (string= (first (getf item :result))
+					     role-1)
+				    (string= (first (getf item :result))
+					     role-2)
+				    (string= (first (getf item :result))
+					     "<http://some.where/ii/role-2>")))
+			     (is (or (string= (second (getf item :result))
+					      role-1)
+				     (string= (second (getf item :result))
+					      role-2)
+				     (string= (second (getf item :result))
+					      "<http://some.where/ii/role-2>"))))
+			    ((string= (getf item :variable) "assoc2")
+			     (is (string= (first (getf item :result))
+					  "<http://some.where/ii/association>")))
+			    (t
+			     (is-true (format t "bad variable-name found")))))
+	   r-1))))
+
+
+
+
+
+;TODO:  tms:player, tms:topicProperty, tms:scope, tms:value, complex filter
+;TODO: "PREFIX tms:<http://www.networkedplanet.com/tmsparql/>
+;       SELECT * WHERE {
+;        ?assoc tms:reifier <http://some.where/ii/association-reifier>.
+;        ?assoc tms:role ?roles}
+; => ?assoc = http://some.where/ii/association
+; => ?roles = (http://some.where/ii/role-2, _:r????)
 
 
 (defun run-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	Fri Apr  1 08:50:49 2011
@@ -201,13 +201,14 @@
   </tm:topic>
 
   <tm:association reifier="http://some.where/ii/association-reifier">
-    <tm:itemIdentity href="http://somw.where/ii/association"/>
+    <tm:itemIdentity href="http://some.where/ii/association"/>
     <tm:type><tm:topicRef href="#written-by"/></tm:type>
     <tm:role reifier="http://some.where/ii/role-reifier">
       <tm:type><tm:topicRef href="#writer"/></tm:type>
       <tm:topicRef href="#goethe"/>
     </tm:role>
     <tm:role>
+      <tm:itemIdentity href="http://some.where/ii/role-2"/>
       <tm:type><tm:topicRef href="#written"/></tm:type>
       <tm:topicRef href="#zauberlehrling"/>
     </tm:role>