[isidorus-cvs] r378 - in trunk/src: TM-SPARQL unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Dec 20 16:25:54 UTC 2010
Author: lgiessmann
Date: Mon Dec 20 11:25:53 2010
New Revision: 378
Log:
TM-SPARQL: adapted some unit-tests to the latest changes; fixed a bug when calculating the final result
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_filter.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 Mon Dec 20 11:25:53 2010
@@ -271,9 +271,14 @@
(concatenate 'string "(" (value (object construct))
" " (elt (object-result construct) row-idx) ")")))
(var-let
- (concatenate 'string "(let ((true t) (false nil)"
+ (concatenate 'string "(let ((true t) (false nil) "
subj-var pred-var obj-var ")"))
- (expression (concatenate 'string var-let filter-string ")")))
+ (expression
+ (concatenate 'string var-let "(cl:handler-case "
+ filter-string
+ "(exception:sparql-parser-error (err) "
+ "(cl:in-package :cl-user) "
+ "(error err)))")))
(when (eval (read-from-string expression))
(push (list :subject (elt (subject-result construct) row-idx)
:predicate (elt (predicate-result construct) row-idx)
@@ -945,11 +950,16 @@
(when var-elem
(let* ((rows-to-hold
(remove-null
- (map 'list #'(lambda(val)
- (if (stringp val)
- (position val var-elem :test #'string=)
- (position val var-elem)))
- dont-touch-values)))
+ (map 'list #'(lambda(res)
+ (when (cond
+ ((stringp res)
+ (find res dont-touch-values :test #'string=))
+ ((numberp res)
+ (find res dont-touch-values :test #'=))
+ (t
+ (find res dont-touch-values)))
+ (position res var-elem)))
+ var-elem)))
(new-result-list
(map 'list
#'(lambda(row-idx)
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp Mon Dec 20 11:25:53 2010
@@ -122,10 +122,6 @@
construct filter-string-functions original-filter-string))
(parse-group construct next-query))))
;;TODO: implement
- ;; *implement wrapper functions, also for the operators
- ;; it would be nice when the self defined operator functions would be in a
- ;; separate packet, e.g. filter-functions, so =, ... would couse no
- ;; collisions
;; *add ^^datatype to the object-literal-results
;; *implement to-literal => CharacteristicC => \"...\"^^datatype => use for tm-sparql
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Mon Dec 20 11:25:53 2010
@@ -37,7 +37,8 @@
:test-set-*-and-/-operators
:test-set-+-and---operators
:test-set-compare-operators
- :test-set-functions))
+ :test-set-functions
+ :test-module-1))
(in-package :sparql-test)
@@ -472,7 +473,7 @@
(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 (string= pred-1 "<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>"))))
(t
@@ -867,7 +868,7 @@
(is (= (length (tm-sparql::subject-result
(first (tm-sparql::select-group q-obj-3)))) 0))
(is (= (length (tm-sparql::subject-result
- (second (tm-sparql::select-group q-obj-3)))) 1))
+ (second (tm-sparql::select-group q-obj-3)))) 0))
(is (or (string= "<http://some.where/psis/author/goethe>"
(first (tm-sparql::subject-result
(first (tm-sparql::select-group q-obj-1)))))
@@ -922,18 +923,12 @@
(first (tm-sparql::select-group q-obj-3)))))
(is-false (first (tm-sparql::object-result
(first (tm-sparql::select-group q-obj-3)))))
- (is (or (string= "<http://some.where/psis/author/goethe>"
- (first (tm-sparql::subject-result
- (second (tm-sparql::select-group q-obj-3)))))
- (string= "<http://some.where/psis/persons/goethe>"
- (first (tm-sparql::subject-result
- (second (tm-sparql::select-group q-obj-3)))))))
- (is (string= "<http://some.where/base-psis/last-name>"
- (first (tm-sparql::predicate-result
- (second (tm-sparql::select-group q-obj-3))))))
- (is (string= "von Goethe"
- (first (tm-sparql::object-result
- (second (tm-sparql::select-group q-obj-3))))))))))
+ (is-false (first (tm-sparql::subject-result
+ (second (tm-sparql::select-group q-obj-3)))))
+ (is-false (first (tm-sparql::predicate-result
+ (second (tm-sparql::select-group q-obj-3)))))
+ (is-false (first (tm-sparql::object-result
+ (second (tm-sparql::select-group q-obj-3)))))))))
(test test-result
@@ -1528,7 +1523,43 @@
"(or(progn(DATATYPE?var3))(progn(isLITERAL(=(one+?var1)(one-?var2)))))"))
(is (string= (string-replace result-5-6 " " "")
"(or(progn(DATATYPE?var3))(progn(progn(isLITERAL(=(one+?var1)(one-?var2))))))"))))
-
+
+
+;(test test-module-1
+; "Tests the entire module."
+; (with-fixture with-tm-filled-db ("data_base" *poems.xtm*)
+; (with-revision 0
+; (let* ((query-1
+; "BASE <http://some.where/psis/poem/>
+; SELECT $subject ?predicate WHERE{
+; ?subject $predicate <zauberlehrling> .
+; FILTER (STR(?predicate) = 'http://some.where/base-psis/written')}")
+; (query-2 "SELECT ?object ?subject WHERE{
+; <http://some.where/psis/author/goethe> ?prediate ?object .
+; FILTER (isLITERAL(?object) &&
+; DATATYPE(?object) =
+; 'http://www.w3.org/2001/XMLSchema#string')}")
+; (query-3 "SELECT ?object ?subject WHERE{
+; <http://some.where/psis/author/goethe> ?prediate ?object .
+; FILTER (notAllowed(?subject)}")
+; (query-4 "SELECT ?object ?subject WHERE{
+; <http://some.where/psis/author/goethe> ?prediate ?object .
+; FILTER ((notAllowed ?subject))}")
+; (query-5 "SELECT ?object ?subject WHERE{
+; <http://some.where/psis/author/goethe> ?prediate ?object .
+; FILTER(?a && (?b || ?c)}")
+; (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1))
+; (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)))
+; (is-true q-obj-1)
+; (is-true q-obj-2)
+; (signals excpetions-sparql-parser-error
+; (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))
+; (signals excpetions-sparql-parser-error
+; (make-instance 'TM-SPARQL:SPARQL-Query :query query-4))
+; (signals excpetions-sparql-parser-error
+; (make-instance 'TM-SPARQL:SPARQL-Query :query query-5))
+; ;;TODO: implement
+; ))))
(defun run-sparql-tests ()
More information about the Isidorus-cvs
mailing list