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

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Apr  1 12:52:05 2011
New Revision: 407

Log:
TM-SPARQL: fixed a bug in the setter for elem-type (SPARQL-Triple-Elem)

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 12:52:05 2011
@@ -242,17 +242,17 @@
     (push triple (slot-value construct 'select-group))))
 
 
-(defgeneric (setf elem-type) (construct elem-type)
+(defgeneric (setf elem-type) (value construct)
   (:documentation "Sets the passed elem-type on the passed cosntruct.")
-  (:method ((construct SPARQL-Triple-Elem) (elem-type Symbol))
-    (when (and (not (eql elem-type 'IRI))
-	       (not (eql elem-type 'VARIABLE))
-	       (not (eql elem-type 'LITERAL)))
+  (:method ((value Symbol) (construct SPARQL-Triple-Elem))
+    (when (and (not (eql value 'IRI))
+	       (not (eql value 'VARIABLE))
+	       (not (eql value 'LITERAL)))
       (error (make-condition
 	      'bad-argument-error
 	      :message (format nil "Expected a one of the symbols ~a, but get ~a~%"
-			       '('IRI 'VARIABLE 'LITERAL) elem-type))))
-    (setf (slot-value construct 'elem-type) elem-type)))
+			       '('IRI 'VARIABLE 'LITERAL) value))))
+    (setf (slot-value construct 'elem-type) value)))
 
 
 (defgeneric add-prefix (construct prefix-label prefix-value)
@@ -771,9 +771,9 @@
 	(cond ((variable-p (object construct))
 	       (when (typep subj 'TopicC)
 		 (append (filter-characteristics
-			  subj pred nil nil :revision revision)
-			 (filter-associations
-			  subj pred nil :revision revision))))
+				     subj pred nil nil :revision revision)
+				    (filter-associations
+				     subj pred nil :revision revision))))
 	      ((literal-p (object construct))
 	       (when (typep subj 'TopicC)
 		 (filter-characteristics

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 12:52:05 2011
@@ -58,6 +58,7 @@
                    and its objects corresponding to the defined
                    special-uris, e.g. <subj> var <obj>.")
   (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+    (setf (elem-type (predicate construct)) 'IRI)
     (let* ((pred (predicate construct))
 	   (old-pred-value (value pred))
 	   (res-1
@@ -90,6 +91,7 @@
 	      (let ((val (filter-for-player construct :revision revision)))
 		(setf (value pred) old-pred-value)
 		val))))
+      (setf (elem-type (predicate construct)) 'VARIABLE)
       (append res-1 res-2 res-3 res-4 res-5))))
 
 

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 12:52:05 2011
@@ -2059,6 +2059,24 @@
 	   r-1))))
 
 
+(test test-all-11
+  "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> ?pred1 ?obj1.
+		   <http://some.where/ii/association> ?pred2 ?obj2.
+                   <http://some.where/ii/role-2> ?pred3 ?obj3.
+                   <http://some.where/ii/goethe-untyped-name> ?pred4 ?obj4.
+                   <http://some.where/ii/goethe-occ> ?pred5 ?obj5.
+                   <http://some.where/ii/goethe-variant> ?pred6 ?obj6"
+                 "}"))
+	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
+      (is-true (= (length r-1) 12))
+      (format t "~a~%" r-1))))
+
 
 
 ;TODO: complex filter,