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

Lukas Giessmann lgiessmann at common-lisp.net
Sun Nov 28 19:47:27 UTC 2010


Author: lgiessmann
Date: Sun Nov 28 14:47:27 2010
New Revision: 356

Log:
TM-SPARQL: added some unit-tests for processing single triples in a SELECT-WHERE statement => fixed some bugs in the SPARQL-queries

Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_parser.lisp
   trunk/src/unit_tests/poems.xtm
   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	Sun Nov 28 14:47:27 2010
@@ -114,7 +114,13 @@
 
 
 (defclass SPARQL-Query ()
-  ((original-query :initarg :query
+  ((revision :initarg :revision
+	     :accessor revision
+	     :type Integer
+	     :initform 0
+	     :documentation "Represents the revision in which all the queries
+                             are processed in the DB.")
+   (original-query :initarg :query
 		   :accessor original-query  ;this value is only for internal
 					     ;purposes and mustn't be reset
 		   :type String
@@ -230,9 +236,9 @@
 			 (filter-by-given-predicate construct :revision revision)
 			 (filter-by-given-object construct :revision revision))))
 	(map 'list #'(lambda(result)
-		       (push (getf result :subject) (subject construct))
-		       (push (getf result :predicate) (predicate construct))
-		       (push (getf result :object) (object construct)))
+		       (push (getf result :subject) (subject-result construct))
+		       (push (getf result :predicate) (predicate-result construct))
+		       (push (getf result :object) (object-result construct)))
 	     ;;literal-datatype is not used and is not returned, since
 	     ;;the values are returned as object of their specific type, e.g.
 	     ;;integer, boolean, string, ...
@@ -244,7 +250,9 @@
                    of a given object.")
   (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
     (declare (Integer revision))
-    (unless (variable-p (object construct))
+    (when (and (not (variable-p (object construct)))
+	       (variable-p (predicate construct))
+	       (variable-p (subject construct)))
       (cond ((literal-p (object construct))
 	     (filter-by-characteristic-value (value (object construct))
 					     (literal-datatype (object construct))
@@ -304,7 +312,12 @@
 			      :predicate pred
 			      :object (charvalue char)
 			      :literal-datatyp literal-datatype))))
-	  chars))))
+	  ;;elephant returns names, occurences, and variants if any string
+	  ;;value matches, so all duplicates have to be removed, additionaly
+	  ;;variants have to be remove completely
+	  (remove-if #'(lambda(obj)
+			 (typep obj 'VariantC))
+		     (remove-duplicates chars))))))
 
 
 (defgeneric filter-by-otherplayer (construct &key revision)
@@ -328,7 +341,7 @@
 			(when-do type (instance-of role :revision revision)
 				 (any-id type :revision revision)))
 		       (subj-uri
-			(when-do plr (instance-of orole :revision revision)
+			(when-do plr (player orole :revision revision)
 				 (any-id plr :revision revision))))
 		  (when (and obj-uri pred-uri subj-uri)
 		    (list :subject subj-uri
@@ -364,16 +377,18 @@
     (when (or (variable-p (object construct))
 	      (iri-p (object construct)))
       (let* ((roles-by-type
-	      (map 'list #'(lambda(typed-construct)
-			     (when (typep typed-construct 'RoleC)
-			       typed-construct))
-		   (used-as-type construct :revision revision)))
+	      (remove-null
+	       (map 'list #'(lambda(typed-construct)
+			      (when (typep typed-construct 'RoleC)
+				typed-construct))
+		    (used-as-type (value (predicate construct)) :revision revision))))
 	     (roles-by-player
 	      (if (iri-p (object construct))
 		  (remove-null
 		   (map 'list #'(lambda(role)
-				  (when (eql (instance-of role :revision revision)
-					     (value (object construct)))))
+				  (when (eql (player role :revision revision)
+					     (value (object construct)))
+				    role))
 			roles-by-type))
 		  roles-by-type))
 	     (pred-uri (any-id (value (predicate construct)) :revision revision)))
@@ -415,7 +430,7 @@
   (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
     (declare (Integer revision))
     (when (and (not (iri-p (object construct)))
-	       (or (not (literal-datatype construct))
+	       (or (not (literal-datatype (object construct)))
 		   (string= (literal-datatype construct) *xml-string*)))
       (let* ((names-by-type
 	      (remove-null
@@ -426,12 +441,13 @@
 				  :revision revision))))
 	     (names-by-literal
 	      (if (variable-p (object construct))
+		  names-by-type
 		  (remove-null
 		   (map 'list #'(lambda(name)
-				  (string= (charvalue name)
-					   (value (object construct))))
-			names-by-type))
-		  names-by-type)))
+				  (when (string= (charvalue name)
+						 (value (object construct)))
+				    name))
+			names-by-type)))))
 	(remove-null
 	 (map 'list
 	      #'(lambda(name)
@@ -713,4 +729,6 @@
 (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args)
   (declare (ignorable args))
   (parser-start construct (original-query construct))
+  (dolist (triple (select-group construct))
+    (set-results triple :revision (revision construct)))
   construct)
\ No newline at end of file

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Sun Nov 28 14:47:27 2010
@@ -208,11 +208,12 @@
 		((string-starts-with-digit trimmed-str)
 		 (parse-literal-number-value trimmed-str query-object)))))
     (list :next-query (getf value-type-lang-query :next-query)
-	  :value (make-instance 'SPARQL-Triple-Elem
-				:elem-type 'LITERAL
-				:value (getf value-type-lang-query :value)
-				:literal-lang (getf value-type-lang-query :lang)
-				:literal-type (getf value-type-lang-query :type)))))
+	  :value (make-instance
+		  'SPARQL-Triple-Elem
+		  :elem-type 'LITERAL
+		  :value (getf value-type-lang-query :value)
+		  :literal-lang (getf value-type-lang-query :lang)
+		  :literal-datatype (getf value-type-lang-query :type)))))
 
 
 (defun parse-literal-string-value (query-string query-object)

Modified: trunk/src/unit_tests/poems.xtm
==============================================================================
--- trunk/src/unit_tests/poems.xtm	(original)
+++ trunk/src/unit_tests/poems.xtm	Sun Nov 28 14:47:27 2010
@@ -1,16 +1,16 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/">
-  <!-- ======================================================================= -->
-  <!--  Isidorus                                                               -->
-  <!--  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff          -->
-  <!--                                                                         -->
-  <!--  Isidorus is freely distributable under the LLGPL license.              -->
-  <!--  This ajax module uses the frameworks PrototypeJs and Scriptaculous,    -->
-  <!--  both are distributed under the MIT license.                            -->
-  <!--  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt,   -->
-  <!--  trunk/docs/LGPL-LICENSE.txt and in                                     -->
-  <!--  trunk/src/ajax/javascripts/external/MIT-LICENSE.txt.                   -->
-  <!-- ======================================================================= -->
+  <!-- ===================================================================== -->
+  <!--  Isidorus                                                             -->
+  <!--  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff        -->
+  <!--                                                                       -->
+  <!--  Isidorus is freely distributable under the LLGPL license.            -->
+  <!--  This ajax module uses the frameworks PrototypeJs and Scriptaculous,  -->
+  <!--  both are distributed under the MIT license.                          -->
+  <!--  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, -->
+  <!--  trunk/docs/LGPL-LICENSE.txt and in                                   -->
+  <!--  trunk/src/ajax/javascripts/external/MIT-LICENSE.txt.                 -->
+  <!-- ===================================================================== -->
   <!-- ===================================================================== -->
   <!-- === TMCL meta-model topics ========================================== -->
   <!-- ===================================================================== -->

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Sun Nov 28 14:47:27 2010
@@ -12,6 +12,9 @@
 	 :it.bese.FiveAM
 	 :TM-SPARQL
 	 :exceptions
+	 :unittests-constants
+	 :fixtures
+	 :d
 	 :constants)
   (:export :run-sparql-tests
 	   :sparql-tests
@@ -19,7 +22,9 @@
 	   :test-parse-literals
 	   :test-parse-triple-elem
 	   :test-parse-group-1
-	   :test-parse-group-2))
+	   :test-parse-group-2
+	   :test-set-result-1
+	   :test-set-result-2))
 
 
 (in-package :sparql-test)
@@ -408,5 +413,254 @@
       (is-false (tm-sparql::literal-lang (tm-sparql::object elem))))))
 
 
+(test test-set-result-1
+  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
+    (with-revision 0
+      (let* ((query-1 "BASE <http://some.where/>
+                       SELECT ?subject ?predicate ?object WHERE {
+                         ?subject ?predicate ?object }")
+	     (query-2 "BASE <http://some.where/psis/poem/>
+                       SELECT $subject ?predicate WHERE{
+                         ?subject $predicate <zauberlehrling> }")
+	     (query-3 "SELECT ?predicate ?subject WHERE
+                         {?subject ?predicate \"Johann Wolfgang\" }")
+	     (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
+	     (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
+	     (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
+	(is-true q-obj-1)
+	(is (= (length (tm-sparql::select-group q-obj-1)) 1))
+	(is-true q-obj-2)
+	(is (= (length (tm-sparql::select-group q-obj-2)) 1))
+	(is-true q-obj-3)
+	(is (= (length (tm-sparql::select-group q-obj-3)) 1))
+	(is-false (tm-sparql::subject-result
+		   (first (tm-sparql::select-group q-obj-1))))
+	(is-false (tm-sparql::predicate-result
+		   (first (tm-sparql::select-group q-obj-1))))
+	(is-false (tm-sparql::object-result
+		   (first (tm-sparql::select-group q-obj-1))))
+	(is (= (length (tm-sparql::subject-result
+			(first (tm-sparql::select-group q-obj-2)))) 2))
+	(is (= (length (tm-sparql::predicate-result
+			(first (tm-sparql::select-group q-obj-2)))) 2))
+	(is (= (length (tm-sparql::object-result
+			(first (tm-sparql::select-group q-obj-2)))) 2))
+	(let ((subj-1 (first (tm-sparql::subject-result
+			      (first (tm-sparql::select-group q-obj-2)))))
+	      (subj-2 (second (tm-sparql::subject-result
+			       (first (tm-sparql::select-group q-obj-2)))))
+	      (pred-1 (first (tm-sparql::predicate-result
+			      (first (tm-sparql::select-group q-obj-2)))))
+	      (pred-2 (second (tm-sparql::predicate-result
+			       (first (tm-sparql::select-group q-obj-2)))))
+	      (obj-1 (first (tm-sparql::object-result
+			      (first (tm-sparql::select-group q-obj-2)))))
+	      (obj-2 (second (tm-sparql::object-result
+			       (first (tm-sparql::select-group q-obj-2))))))
+	  (cond ((or (string= subj-1 "http://some.where/psis/author/goethe")
+		     (string= subj-1 "http://some.where/psis/persons/goethe"))
+		 (is (string= pred-1 "http://some.where/base-psis/written"))
+		 (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling")
+			 (string= obj-1 "http://some.where/psis/der_zauberlehrling")))
+		 (is (string= subj-2 "http://some.where/base-psis/poem"))
+		 (is (string= pred-2 "http://psi.topicmaps.org/iso13250/model/instance"))
+		 (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling")
+			 (string= obj-2 "http://some.where/psis/der_zauberlehrling"))))
+		((string= subj-1 "http://some.where/base-psis/poem")
+		 (is (string= pred-2 "http://some.where/base-psis/written"))
+		 (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling")
+			 (string= obj-1 "http://some.where/psis/der_zauberlehrling")))
+		 (is (or (string= subj-2 "http://some.where/psis/author/goethe")
+			 (string= subj-2 "http://some.where/psis/persons/goethe")))
+		 (is (string= pred-1 "http://psi.topicmaps.org/iso13250/model/type"))
+		 (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling")
+			 (string= obj-2 "http://some.where/psis/der_zauberlehrling"))))
+		(t
+		 (is-true nil))))
+	(is (= (length (tm-sparql::subject-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (= (length (tm-sparql::predicate-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (= (length (tm-sparql::object-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (or (string= (first (tm-sparql::subject-result
+				 (first (tm-sparql::select-group q-obj-3))))
+			 "http://some.where/psis/author/goethe")
+		(string= (first (tm-sparql::subject-result
+				 (first (tm-sparql::select-group q-obj-3))))
+			 "http://some.where/psis/persons/goethe")))
+	(is (string= (first (tm-sparql::predicate-result
+			     (first (tm-sparql::select-group q-obj-3))))
+		     "http://some.where/base-psis/first-name"))
+	(is (string= (first (tm-sparql::object-result
+			     (first (tm-sparql::select-group q-obj-3))))
+		     "Johann Wolfgang"))))))
+
+
+(test test-set-result-2
+  (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
+    (with-revision 0
+      (let* ((query-1 "PREFIX pref:<http://some.where/base-psis/>
+                       SELECT $subject $object WHERE {
+                         ?subject pref:written ?object }")
+	     (query-2 "BASE <http://some.where/base-psis/>
+                       SELECT $subject $object WHERE {
+                         ?subject <first-name> ?object }")
+	     (query-3 "BASE <http://some.where/psis/>
+                       SELECT ?subject WHERE{
+                         ?subject <http://some.where/base-psis/written>
+                           <poem/zauberlehrling>}")
+	     (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
+	     (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2))
+	     (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3)))
+	(is-true q-obj-1)
+	(is (= (length (tm-sparql::select-group q-obj-1)) 1))
+	(is (= (length (tm-sparql::subject-result
+			(first (tm-sparql::select-group q-obj-1)))) 4))
+	(is (= (length (tm-sparql::predicate-result
+			(first (tm-sparql::select-group q-obj-1)))) 4))
+	(is (= (length (tm-sparql::object-result
+			(first (tm-sparql::select-group q-obj-1)))) 4))
+	(let* ((s-1 (first (tm-sparql::subject-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (s-2 (second (tm-sparql::subject-result
+			     (first (tm-sparql::select-group q-obj-1)))))
+	       (s-3 (third (tm-sparql::subject-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (s-4 (fourth (tm-sparql::subject-result
+			     (first (tm-sparql::select-group q-obj-1)))))
+	       (p-1 (first (tm-sparql::predicate-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (p-2 (second (tm-sparql::predicate-result
+			     (first (tm-sparql::select-group q-obj-1)))))
+	       (p-3 (third (tm-sparql::predicate-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (p-4 (fourth (tm-sparql::predicate-result
+			     (first (tm-sparql::select-group q-obj-1)))))
+	       (o-1 (first (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (o-2 (second (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (o-3 (third (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-1)))))
+	       (o-4 (fourth (tm-sparql::object-result
+			     (first (tm-sparql::select-group q-obj-1))))))
+	  (is (string= p-1 "http://some.where/base-psis/written"))
+	  (is (string= p-2 "http://some.where/base-psis/written"))
+	  (is (string= p-3 "http://some.where/base-psis/written"))
+	  (is (string= p-4 "http://some.where/base-psis/written"))
+	  (is (or (not (set-exclusive-or
+			(list "http://some.where/psis/author/eichendorff"
+			      "http://some.where/psis/author/schiller"
+			      "http://some.where/psis/author/goethe")
+			(list s-1 s-2 s-3 s-4)
+			:test #'string=))
+		  (not (set-exclusive-or
+			(list "http://some.where/psis/author/eichendorff"
+			      "http://some.where/psis/author/schiller"
+			      "http://some.where/psis/persons/goethe")
+			(list s-1 s-2 s-3 s-4)
+			:test #'string=))))
+	  (is-false (set-exclusive-or
+		     (list "http://some.where/psis/poem/mondnacht"
+			   "http://some.where/psis/poem/resignation"
+			   "http://some.where/psis/poem/erlkoenig"
+			   "http://some.where/psis/poem/zauberlehrling")
+		     (list o-1 o-2 o-3 o-4)
+		     :test #'string=)))
+	(is-true q-obj-2)
+	(is (= (length (tm-sparql::subject-result
+			(first (tm-sparql::select-group q-obj-2)))) 3))
+	(is (= (length (tm-sparql::predicate-result
+			(first (tm-sparql::select-group q-obj-2)))) 3))
+	(is (= (length (tm-sparql::object-result
+			(first (tm-sparql::select-group q-obj-2)))) 3))
+	(let* ((s-1 (first (tm-sparql::subject-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (s-2 (second (tm-sparql::subject-result
+			     (first (tm-sparql::select-group q-obj-2)))))
+	       (s-3 (third (tm-sparql::subject-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (p-1 (first (tm-sparql::predicate-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (p-2 (second (tm-sparql::predicate-result
+			     (first (tm-sparql::select-group q-obj-2)))))
+	       (p-3 (third (tm-sparql::predicate-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (o-1 (first (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (o-2 (second (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-2)))))
+	       (o-3 (third (tm-sparql::object-result
+			    (first (tm-sparql::select-group q-obj-2))))))
+	  (string= p-1 "http://some.where/base-psis/first-name")
+	  (string= p-2 "http://some.where/base-psis/first-name")
+	  (string= p-3 "http://some.where/base-psis/first-name")
+	  (cond ((string= o-1 "Johann Christoph Friedrich")
+		 (is (string= s-1 "http://some.where/psis/author/schiller"))
+		 (cond ((string= o-2 "Johann Wolfgang")
+			(is (or (string= s-2 "http://some.where/psis/author/goethe")
+				(string= s-2 "http://some.where/psis/persons/goethe")))
+			(is (string= s-3 "http://some.where/psis/author/eichendorff"))
+			(is (string= o-3 "Joseph Karl Benedikt")))
+		       ((string= o-2 "Joseph Karl Benedikt")
+			(is (string= s-2 "http://some.where/psis/author/eichendorff"))
+			(is (or (string= s-3 "http://some.where/psis/author/goethe")
+				(string= s-3 "http://some.where/psis/persons/goethe")))
+			(is (string= o-3 "Johann Wolfgang")))
+		       (t
+			(is-true nil))))
+		((string= o-1 "Johann Wolfgang")
+		 (is (or (string= s-1 "http://some.where/psis/author/goethe")
+			 (string= s-1 "http://some.where/psis/persons/goethe")))
+		 (cond ((string= o-2 "Johann Christoph Friedrich")
+			(is (string= s-2 "http://some.where/psis/author/schiller"))
+			(is (string= s-3 "http://some.where/psis/author/eichendorff"))
+			(is (string= o-3 "Joseph Karl Benedikt")))
+		       ((string= o-2 "Joseph Karl Benedikt")
+			(is (string= s-2 "http://some.where/psis/author/eichendorff"))
+			(is (string= s-3 "http://some.where/psis/author/schiller"))
+			(is (string= o-3 "Johann Christoph Friedrich")))
+		       (t
+			(is-true nil))))
+		((string= o-1 "Joseph Karl Benedikt")
+		 (is (string= s-1 "http://some.where/psis/author/eichendorff"))
+		 (cond ((string= o-2 "Johann Wolfgang")
+			(is (or (string= s-2 "http://some.where/psis/author/goethe")
+				(string= s-2 "http://some.where/psis/persons/goethe")))
+			(is (string= s-3 "http://some.where/psis/author/schiller"))
+			(is (string= o-3 "Johann Christoph Friedrich")))
+		       ((string= o-2 "Johann Christoph Friedrich")
+			(is (string= s-2 "http://some.where/psis/author/schiller"))
+			(is (or (string= s-3 "http://some.where/psis/author/goethe")
+				(string= s-3 "http://some.where/psis/persons/goethe")))
+			(is (string= o-3 "Johann Wolfgang")))
+		       (t
+			(is-true nil))))
+		(t
+		 (is-true nil))))
+	(is-true q-obj-3)
+	(is (= (length (tm-sparql::select-group q-obj-3)) 1))
+	(is (= (length (tm-sparql::subject-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (= (length (tm-sparql::predicate-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (= (length (tm-sparql::object-result
+			(first (tm-sparql::select-group q-obj-3)))) 1))
+	(is (or (string= (first (tm-sparql::subject-result
+				 (first (tm-sparql::select-group q-obj-3))))
+			 "http://some.where/psis/author/goethe")
+		(string= (first (tm-sparql::subject-result
+				 (first (tm-sparql::select-group q-obj-3))))
+			 "http://some.where/psis/persons/goethe")))
+	(is (string= (first (tm-sparql::predicate-result
+			     (first (tm-sparql::select-group q-obj-3))))
+		     "http://some.where/base-psis/written"))
+	(is (string= (first (tm-sparql::object-result
+			     (first (tm-sparql::select-group q-obj-3))))
+		     "http://some.where/psis/poem/zauberlehrling"))))))
+      
+
+
 (defun run-sparql-tests ()
   (it.bese.fiveam:run! 'sparql-test:sparql-tests))




More information about the Isidorus-cvs mailing list