[isidorus-cvs] r417 - in trunk/src: TM-SPARQL base-tools unit_tests - isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

6 Apr 2011

Author: lgiessmann
Date: Wed Apr  6 05:26:02 2011
New Revision: 417
Log:
TM-SPARQL: adopted all unit-tests to the latest changes; fixed some bug that handles unsupported datatypes
Modified:
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_parser.lisp
   trunk/src/base-tools/base-tools.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	Wed Apr  6 05:26:02 2011
@@ -589,7 +589,7 @@
    		(list :subject subj-uri
    		      :predicate pred-uri
    		      :object (charvalue char)
-			      :literal-datatype literal-datatype))))
+			      :literal-datatype literal-datatype))))	  
      (remove-if #'(lambda(char)
    		 (typep char 'VariantC))
    	     (return-characteristics literal-value literal-datatype)))))
@@ -909,8 +909,10 @@
         (string/= literal-datatype *xml-boolean*))
    construct
    (handler-case
-	    (let ((occ-value (cast-literal (charvalue construct)
-					   (datatype construct))))
+	    (let ((occ-value
+		   (cast-literal (charvalue construct)
+				 (datatype construct)
+				 :back-as-string-when-unsupported t)))
          (when (literal= occ-value literal-value)
    	construct))
      (condition () nil)))))	      
@@ -1279,10 +1281,12 @@
       values)))
-(defun cast-literal (literal-value literal-type)
+(defun cast-literal (literal-value literal-type
+		     &key (back-as-string-when-unsupported nil))
   "A helper function that casts the passed string value of the literal
    corresponding to the passed literal-type."
-  (declare (String literal-value literal-type))
+  (declare (String literal-value literal-type)
+	   (Boolean back-as-string-when-unsupported))
   (cond ((string= literal-type *xml-string*)
     literal-value)
    ((string= literal-type *xml-boolean*)
@@ -1294,7 +1298,9 @@
    ((string= literal-type *xml-decimal*)
     (cast-literal-to-decimal literal-value))
    (t ; return the value as a string
-	 (concat """"" literal-value """"^^" literal-type))))
+	 (if back-as-string-when-unsupported
+	     literal-value
+	     (concat """"" literal-value """"^^" literal-type)))))
(defun cast-literal-to-decimal (literal-value)
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Wed Apr  6 05:26:02 2011
@@ -230,7 +230,8 @@
       (l-lang (getf result-2 :lang))
       (next-query (getf result-2 :next-query)))
       (list :next-query next-query :lang l-lang :type l-type
-	    :value (cast-literal l-value l-type)))))
+	    :value (cast-literal l-value l-type
+				 :back-as-string-when-unsupported t)))))
(defgeneric separate-literal-lang-or-type (construct query-string)
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp	(original)
+++ trunk/src/base-tools/base-tools.lisp	Wed Apr  6 05:26:02 2011
@@ -195,12 +195,15 @@
       (let ((search-idx (search-first (list string-to-replace) main-string)))
    (if (not search-idx)
        main-string
-	    (let ((modified-string
-		   (concat (subseq main-string 0 search-idx)
-			   new-string
-			   (subseq main-string
-				   (+ search-idx (length string-to-replace))))))
-	      (string-replace modified-string string-to-replace new-string))))))
+	    (let* ((leading-part (subseq main-string 0 search-idx))
+		   (trailing-part
+		    (subseq main-string
+			    (+ search-idx (length string-to-replace))))
+		   (modified-string
+		    (concat leading-part new-string trailing-part)))
+	      (if (search-first (list string-to-replace) trailing-part)
+		  (string-replace modified-string string-to-replace new-string)
+		  modified-string))))))
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Wed Apr  6 05:26:02 2011
@@ -41,20 +41,20 @@
       :test-set-functions
       :test-module-1
       :test-module-2
-	   :test-all-1
-	   :test-all-2
-	   :test-all-3
-	   :test-all-4
-	   :test-all-5
-	   :test-all-6
-	   :test-all-7
-	   :test-all-8
-	   :test-all-9
-	   :test-all-10
-	   :test-all-11
-	   :test-all-12
-	   :test-all-13
-	   :test-all-14))
+	   :test-module-3
+	   :test-module-4
+	   :test-module-5
+	   :test-module-6
+	   :test-module-7
+	   :test-module-8
+	   :test-module-9
+	   :test-module-10
+	   :test-module-11
+	   :test-module-12
+	   :test-module-13
+	   :test-module-14
+	   :test-module-15
+	   :test-module-16))
(in-package :sparql-test)
@@ -1603,7 +1603,7 @@
          (is-false (set-exclusive-or
    		 (getf (second result-2) :result)
    		 (list "Johann Wolfgang" "von Goethe"
-			       "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")
+			       (concat """"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe%5C%22%5C%22%5C%22%5E..." *xml-uri*))
    		 :test #'string=)))
        (progn 
          (is (= (length (getf (second result-2) :result)) 0))
@@ -1612,7 +1612,7 @@
          (is-false (set-exclusive-or
    		 (getf (first result-2) :result)
    		 (list "Johann Wolfgang" "von Goethe"
-			       "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")
+			       (concat """"http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe%5C%22%5C%22%5C%22%5E..." *xml-uri*))
    		 :test #'string=))))))))
@@ -1642,7 +1642,7 @@
    	   :test #'string=))))))
-(test test-all-1
+(test test-module-3
   "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)
@@ -1698,7 +1698,7 @@
     (is-true (d:get-item-by-psi *rdf-type* :revision 0))))
-(test test-all-2
+(test test-module-4
   "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)
@@ -1724,7 +1724,7 @@
       r-1))))
-(test test-all-3
+(test test-module-5
   "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)
@@ -1752,7 +1752,7 @@
       r-1))))
-(test test-all-4
+(test test-module-6
   "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)
@@ -1802,7 +1802,7 @@
       r-1))))
-(test test-all-5
+(test test-module-7
   "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)
@@ -1831,7 +1831,7 @@
       r-1))))
-(test test-all-6
+(test test-module-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)
@@ -1874,7 +1874,7 @@
       r-1))))
-(test test-all-7
+(test test-module-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)
@@ -1898,7 +1898,7 @@
       r-1))))
-(test test-all-8
+(test test-module-10
   "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)
@@ -1921,7 +1921,8 @@
    				 "Johann Wolfgang von Goethe")))
    		   ((string= (getf item :variable) "obj2")
    		    (is (string= (first (getf item :result))
-					 "28.08.1749")))
+					 (concat """"28.08.1749"""^^"
+						 *xml-date*))))
    		   ((string= (getf item :variable) "obj3")
    		    (is (string= (first (getf item :result))
    				 "Goethe")))
@@ -1942,7 +1943,7 @@
       r-1))))
-(test test-all-9
+(test test-module-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)
@@ -1961,7 +1962,7 @@
       (is-false r-1))))
-(test test-all-10
+(test test-module-12
   "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)
@@ -2074,7 +2075,7 @@
       r-1))))
-(test test-all-11
+(test test-module-13
   "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)
@@ -2127,24 +2128,27 @@
    		   ((string= (getf item :variable) "obj1")
    		    (is (= (length (getf item :result)) 17))
    		    (is-true (find "Johann Wolfgang" (getf item :result)
-					   :test #'string=))
+					   :test #'tm-sparql::literal=))
    		    (is-true (find "von Goethe" (getf item :result)
-					   :test #'string=))
-			    (is-true (find "true" (getf item :result)
-					   :test #'string=))
-			    (is-true (find "false" (getf item :result)
-					   :test #'string=))
-			    (is-true (find "28.08.1749" (getf item :result)
-					   :test #'string=))
-			    (is-true (find "22.03.1832" (getf item :result)
-					   :test #'string=))
-			    (is-true (find "82" (getf item :result)
-					   :test #'string=))
+					   :test #'tm-sparql::literal=))
+			    (is-true (find t (getf item :result)
+					   :test #'tm-sparql::literal=))
+			    (is-true (position nil (getf item :result)
+					       :test #'tm-sparql::literal=))
+			    (is-true (find (concat "'28.08.1749'^^" *xml-date*)
+					   (getf item :result)
+					   :test #'tm-sparql::literal=))
+			    (is-true (find (concat "'22.03.1832'^^" *xml-date*)
+					   (getf item :result)
+					   :test #'tm-sparql::literal=))
+			    (is-true (find 82 (getf item :result)
+					   :test #'tm-sparql::literal=))
    		    (is-true (find "http://some.where/tmsparql/author"
-					   (getf item :result) :test #'string=))
+					   (getf item :result)
+					   :test #'tm-sparql::literal=))
    		    (is-true
    		     (find "http://some.where/psis/poem/zauberlehrling"
-				   (getf item :result) :test #'string=)))
+				   (getf item :result) :test #'tm-sparql::literal=)))
    		   ((string= (getf item :variable) "obj2")
    		    (is (= (length (getf item :result)) 3))
    		    (is-false
@@ -2182,9 +2186,9 @@
    		    (is-false
    		     (set-exclusive-or
    		      (getf item :result)
-			      (list "28.08.1749"
+			      (list (concat "'28.08.1749'^^" *xml-date*)
    			    "http://some.where/ii/goethe-occ-reifier")
-			      :test #'string=)))
+			      :test #'tm-sparql::literal=)))
    		   ((string= (getf item :variable) "obj6")
    		   (is (= (length (getf item :result)) 2))
    		    (is-false
@@ -2198,7 +2202,7 @@
       r-1))))
-(test test-all-12
+(test test-module-14
   "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)
@@ -2312,7 +2316,7 @@
-(test test-all-13
+(test test-module-15
   "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)
@@ -2353,14 +2357,14 @@
       r-1))))
-(test test-all-14
+(test test-module-16
   "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
    	 "SELECT * WHERE {
                    http://some.where/tmsparql/author/goethe ?pred1 ?obj1.
-                    FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+                   FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
                    FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
    	   FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
                    FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
@@ -2393,8 +2397,6 @@
;TODO: cast literal-values when called in filters
 ;TODO: test complex filters
-;TODO: check if object results are in the actual object-represenrtation and not as string
-;TODO: rename test-all-? test-module-?
(defun run-sparql-tests ()
   (it.bese.fiveam:run! 'sparql-test:sparql-tests))

    