isidorus-cvs

isidorus-cvs@common-lisp.net

1037 discussions

[isidorus-cvs] r414 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 05 Apr '11

05 Apr '11

Author: lgiessmann Date: Tue Apr 5 07:23:28 2011 New Revision: 414 Log: changed the behavior of casting string-values to xml-boolean, xml-integer, xml-double and xml-decimal Modified: trunk/src/TM-SPARQL/sparql.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 Tue Apr 5 07:23:28 2011 @@ -477,6 +477,7 @@ (filter-by-given-object construct :revision revision)) (filter-by-special-uris construct :revision revision)))) (map 'list #'(lambda(result) + ;(format t "-->~a<--~%" result) ;TODO: remove (push (getf result :subject) (subject-result construct)) (push (getf result :predicate) (predicate-result construct)) (push (getf result :object) (object-result construct))) @@ -1235,35 +1236,88 @@ (cond ((string= literal-type *xml-string*) literal-value) ((string= literal-type *xml-boolean*) - (when (and (string/= literal-value "false") - (string/= literal-value "true")) - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))) - (if (string= literal-value "false") - nil - t)) + (cast-literal-to-boolean literal-value)) ((string= literal-type *xml-integer*) - (handler-case (parse-integer literal-value) - (condition () - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))))) - ((or (string= literal-type *xml-decimal*) ;;both types are - (string= literal-type *xml-double*)) ;;handled the same way - (let ((value (read-from-string literal-value))) - (unless (numberp value) - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))) - value)) + (cast-literal-to-integer literal-value)) + ((string= literal-type *xml-double*) + (cast-literal-to-double literal-value)) + ((string= literal-type *xml-decimal*) + (cast-literal-to-decimal literal-value)) (t ; return the value as a string literal-value))) +(defun cast-literal-to-decimal (literal-value) + "A helper function that casts the passed string value of the literal + value to an decimal value." + (let ((bad-string + (loop for idx to (1- (length literal-value)) + when (and (not (digit-char-p (elt literal-value idx))) + (not (eql (elt literal-value idx) #\.))) + return t))) + (when bad-string + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value *xml-decimal*))))) + ;decimals are handled as single floats + (if (find #\. literal-value) + (read-from-string literal-value) + (read-from-string (concat literal-value ".0")))) + + +(defun cast-literal-to-double (literal-value) + "A helper function that casts the passed string value of the literal + value to an decimal value." + (let ((modified-str "")) + (loop for idx to (1- (length literal-value)) + when (eql (char-downcase (elt literal-value idx)) #\e) + do (push-string "d" modified-str) + else + do (push-string (string (elt literal-value idx)) modified-str)) + (let ((value + (cond ((or (string= "+INF" modified-str) + (string= "INF" modified-str)) + sb-ext:double-float-positive-infinity) + ((string= "-INF" modified-str) + sb-ext:double-float-negative-infinity) + ((find #\d (string-downcase modified-str)) + (read-from-string modified-str)) + (t + (read-from-string (concat modified-str "d0")))))) + (if (typep value 'double-float) + value + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value *xml-double*))))))) + + +(defun cast-literal-to-integer (literal-value) + "A helper function that casts the passed string value of the literal + value to an integer value." + (handler-case (parse-integer literal-value) + (condition () + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value *xml-integer*)))))) + + +(defun cast-literal-to-boolean (literal-value) + "A helper function that casts the passed string value of the literal + value to t or nil." + (when (and (string/= literal-value "false") + (string/= literal-value "true")) + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value *xml-boolean*)))) + (if (string= literal-value "false") + nil + t)) + + (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct)) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Apr 5 07:23:28 2011 @@ -2366,10 +2366,11 @@ ;; to 12 and "\"abc\"" to "abc (map 'list #'(lambda(triple) - (format t "~a - ~a - ~a~%" + (format t "~a - ~a - ~a(~a)~%" (tm-sparql::subject-result triple) (tm-sparql::predicate-result triple) - (tm-sparql::object-result triple))) + (tm-sparql::object-result triple) + (tm-sparql::literal-datatype triple))) (tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))

1 0

[isidorus-cvs] r413 - in trunk/src: TM-SPARQL base-tools unit_tests
by Lukas Giessmann 05 Apr '11

05 Apr '11

Author: lgiessmann Date: Tue Apr 5 05:31:40 2011 New Revision: 413 Log: changed the behavior of the handling of paranthesis and quotations in filters and the behavior of hanlding SPARQL comments 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 Tue Apr 5 05:31:40 2011 @@ -377,6 +377,9 @@ (:documentation "Processes all filters by calling invoke-filter.") (:method ((construct SPARQL-Query)) (dolist (filter (filters construct)) + + (format t ">>>~a<<<~%" filter) ;TODO: remove + (let* ((filter-variable-names (get-variables-from-filter-string filter)) (filter-variable-values nil) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Apr 5 05:31:40 2011 @@ -38,7 +38,10 @@ (if (string-starts-with trimmed-str "#") (let ((next-query (string-after trimmed-str (string #\newline)))) (if next-query - next-query + (let ((cleaned-next-query (cut-comment next-query))) + (if (string= next-query cleaned-next-query) + next-query + (cut-comment next-query))) "")) trimmed-str))) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Tue Apr 5 05:31:40 2011 @@ -437,25 +437,35 @@ (Integer pos)) (let ((result nil)) (dotimes (idx (length filter-string) result) - (let ((current-char (subseq filter-string idx (1+ idx)))) - (cond ((or (string= current-char "'") - (string= current-char "\"")) - (let* ((l-result (get-literal (subseq filter-string idx))) - (next-idx - (when l-result - (- (length filter-string) - (length (getf l-result :next-string)))))) - (when (and next-idx (< pos next-idx)) - (setf result t) - (setf idx (length filter-string))) - (when (<= pos idx) - (setf idx (length filter-string))))) - (t - (when (<= pos idx) - (setf idx (length filter-string))))))))) + (let* ((current-str (subseq filter-string idx)) + (delimiter (cond ((string-starts-with current-str "'''") + "'''") + ((string-starts-with current-str "'") + "'") + ((string-starts-with current-str "\"\"\"") + "\"\"\"") + ((string-starts-with current-str "\"") + "\"")))) + (when delimiter + (let* ((end-pos + (let ((result + (search-first (list delimiter) + (subseq current-str (length delimiter))))) + (when result + (+ (length delimiter) result)))) + (quoted-str (when end-pos + (subseq current-str (length delimiter) end-pos))) + (start-pos idx)) + (incf idx (+ (* 2 (length delimiter)) (length quoted-str))) + (if (and (>= pos start-pos) + (<= pos (+ start-pos end-pos))) + (progn + (setf result t) + (setf idx (length filter-string))) + (incf idx (+ (* 2 (length delimiter)) (length quoted-str)))))))))) -(defun search-first-unclosed-paranthesis (str &key ignore-literals) +(defun search-first-unclosed-paranthesis (str &key (ignore-literals t)) "Returns the idx of the first ( that is not closed, the search is started from the end of the string. If ignore-literals is set to t all paranthesis that are within @@ -467,12 +477,14 @@ (do ((idx (1- (length str)))) ((< idx 0)) (let ((current-char (subseq str idx (1+ idx)))) (cond ((string= current-char ")") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (decf open-brackets))) ((string= current-char "(") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (incf open-brackets) (when (> open-brackets 0) (setf result-idx idx) @@ -481,7 +493,7 @@ result-idx)) -(defun search-first-unopened-paranthesis (str &key ignore-literals) +(defun search-first-unopened-paranthesis (str &key (ignore-literals t)) "Returns the idx of the first paranthesis that is not opened in str. If ignore-literals is set to t all mparanthesis that are within \", \"\"\", ' and ''' are ignored." @@ -492,13 +504,15 @@ (dotimes (idx (length str)) (let ((current-char (subseq str idx (1+ idx)))) (cond ((string= current-char "(") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (decf closed-brackets) (setf result-idx nil))) ((string= current-char ")") - (when (or ignore-literals - (not (in-literal-string-p str idx))) + (when (or (not ignore-literals) + (and ignore-literals + (not (in-literal-string-p str idx)))) (incf closed-brackets) (when (> closed-brackets 0) (setf result-idx idx) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Apr 5 05:31:40 2011 @@ -2339,6 +2339,52 @@ r-1)))) +(test test-all-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) + (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' || 82 = ?obj1) + #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1) + #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))" + " +}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + + + + ;;TODO: use all stored literal datatype information if existent and + ;; cast the values to the actual objects + ;; or + ;; write all string values to the results in a quoted form, + ;; it is also needed to escapte quotes in the actual string value + ;; the filter is called with read-from-string, so a "12" will evaluate + ;; to 12 and "\"abc\"" to "abc + + (map 'list #'(lambda(triple) + (format t "~a - ~a - ~a~%" + (tm-sparql::subject-result triple) + (tm-sparql::predicate-result triple) + (tm-sparql::object-result triple))) + (tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))) + + + + (is-true (= (length r-1) 2)) + (map 'list #'(lambda(item) + (cond + ((string= (getf item :variable) "pred1") + nil) + ((string= (getf item :variable) "obj1") + nil))) + r-1) + (format t "~a~%" r-1)))) + + ;TODO: test complex filters

1 0

[isidorus-cvs] r412 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 04 Apr '11

04 Apr '11

Author: lgiessmann Date: Mon Apr 4 04:50:25 2011 New Revision: 412 Log: TM-SPARQL: fixed a bug in the processing of final results when creating result-intersections and finished a unit-tests for such a scenario Modified: trunk/src/TM-SPARQL/sparql.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 Apr 4 04:50:25 2011 @@ -1080,7 +1080,7 @@ :result (subject-result triple))) (when (variable-p (predicate triple)) (list :variable (value (predicate triple)) - :result (predicate-result triple))) + :result (predicate-result triple))) (when (variable-p (object triple)) (list :variable (value (object triple)) :result (object-result triple))))))))) @@ -1116,7 +1116,7 @@ (let* ((all-values (results-for-variable variable-name result-lists)) (list-1 (when (>= (length all-values) 1) (first all-values))) - (list-2 (if (> (length all-values) 2) + (list-2 (if (>= (length all-values) 2) (second all-values) list-1)) (more-lists (rest (rest all-values)))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Mon Apr 4 04:50:25 2011 @@ -2079,6 +2079,7 @@ (map 'list #'(lambda(item) (cond ((string= (getf item :variable) "pred1") ;one name without a type so it is not listed + ;as regular triple but as tms:topicProperty (is (= (length (getf item :result)) 17))) ((string= (getf item :variable) "pred2") (is (= (length (getf item :result)) 3)) @@ -2297,17 +2298,49 @@ +(test test-all-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) + (let* ((q-1 (concat + "PREFIX tms:<" *tms* "> + SELECT * WHERE { + ?assoc tms:reifier <http://some.where/ii/association-reifier>. + ?assoc tms:role ?roles. + ?roles tms:reifier <http://some.where/ii/role-reifier>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 2)) + (map 'list #'(lambda(item) + (cond + ((string= (getf item :variable) "assoc") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "<http://some.where/ii/association>"))) + ((string= (getf item :variable) "roles") + (is (= (length (getf item :result)) 1)) + (is + (string= + (first (getf item :result)) + (concat + "_:r" + (write-to-string + (elephant::oid + (loop for role in + (roles + (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0) :revision 0) + when (string= + (uri (first (psis (player role :revision 0) + :revision 0))) + "http://some.where/tmsparql/author/goethe") + return role))))))))) + r-1)))) -;TODO: test complex filters, -; test complex relations between variables -;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????) +;TODO: test complex filters (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

[isidorus-cvs] r411 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 03 Apr '11

03 Apr '11

Author: lgiessmann Date: Sun Apr 3 17:12:18 2011 New Revision: 411 Log: TM-SPARQL: fixed a bug in the processing of the property tms:topicProperty; finished the unit-tests for triples of the form ?var1 ?var2 <obj> 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 Sun Apr 3 17:12:18 2011 @@ -495,7 +495,8 @@ (filter-by-characteristic-value (value (object construct)) (literal-datatype (object construct)) :revision revision)) - ((iri-p (object construct)) + ((and (iri-p (object construct)) + (typep (value (object construct)) 'TopicC)) (filter-by-otherplayer (value (object construct)) :revision revision)))))) @@ -1073,8 +1074,6 @@ (remove-null (loop for triple in (select-group construct) append (remove-null - ;;TODO: replace remove-null by a function that check if any of the - ;; list items is nil, if so the entire list should be nil (list (when (variable-p (subject triple)) (list :variable (value (subject triple)) 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 Sun Apr 3 17:12:18 2011 @@ -93,9 +93,16 @@ (setf (value pred) (get-item-by-psi *tms-player* :revision revision)) (let ((val (filter-for-player construct :revision revision))) (setf (value pred) old-pred-value) + val))) + (res-6 + (progn + (setf (value pred) (get-item-by-psi *tms-topicProperty* + :revision revision)) + (let ((val (filter-for-topicProperties 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)))) + (append res-1 res-2 res-3 res-4 res-5 res-6)))) (defgeneric filter-for-player (construct &key revision) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Apr 3 17:12:18 2011 @@ -2079,7 +2079,7 @@ (map 'list #'(lambda(item) (cond ((string= (getf item :variable) "pred1") ;one name without a type so it is not listed - (is (= (length (getf item :result)) 9))) + (is (= (length (getf item :result)) 17))) ((string= (getf item :variable) "pred2") (is (= (length (getf item :result)) 3)) (is-false (set-exclusive-or @@ -2110,15 +2110,26 @@ (concat "<" *tms-scope* ">")) :test #'string=))) ((string= (getf item :variable) "obj1") - (is (= (length (getf item :result)) 9)) - (is-false (set-exclusive-or - (getf item :result) - (list "Johann Wolfgang" "von Goethe" - "28.08.1749" "22.03.1832" "82" - "true" "false" - "<http://some.where/tmsparql/author>" - "<http://some.where/psis/poem/zauberlehrling>") - :test #'string=))) + (is (= (length (getf item :result)) 17)) + (is-true (find "Johann Wolfgang" (getf item :result) + :test #'string=)) + (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=)) + (is-true (find "<http://some.where/tmsparql/author>" + (getf item :result) :test #'string=)) + (is-true + (find "<http://some.where/psis/poem/zauberlehrling>" + (getf item :result) :test #'string=))) ((string= (getf item :variable) "obj2") (is (= (length (getf item :result)) 3)) (is-false @@ -2172,10 +2183,124 @@ r-1)))) +(test test-all-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) + (let* ((q-1 (concat + "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> + SELECT * WHERE { + ?subj1 ?pred1 <http://some.where/tmsparql/author/goethe>. + ?subj2 ?pred2 <http://some.where/ii/goethe-variant>. + ?subj3 ?pred3 <http://some.where/ii/goethe-untyped-name>. + ?subj4 ?pred4 <http://some.where/ii/goethe-occ>. + ?subj5 ?pred5 <http://some.where/ii/association>. + ?subj6 ?pred6 <http://some.where/ii/role-2>. + ?subj7 ?pred7 <http://some.where/tmsparql/display-name>. + ?subj8 ?pred8 <http://some.where/ii/role-reifier>" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-true (= (length r-1) 16)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "pred1") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (list (concat "<" *instance-psi* ">") + "<http://some.where/tmsparql/writer>" + (concat "<" *tms-player* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (list "<http://some.where/tmsparql/author>" + "<http://some.where/psis/poem/zauberlehrling>" + (concat + "_:r" + (write-to-string + (elephant::oid + (first + (player-in-roles + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0))))) + (concat + "_:r" + (write-to-string + (elephant::oid + (second + (player-in-roles + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0)))))) + (getf item :result) :test #'string=))) + ((or (string= (getf item :variable) "pred2") + (string= (getf item :variable) "pred5")) + (is-false (getf item :result))) + ((or (string= (getf item :variable) "subj2") + (string= (getf item :variable) "obj5")) + (is-false (getf item :result))) + ((or (string= (getf item :variable) "pred3") + (string= (getf item :variable) "pred4")) + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-topicProperty* ">")))) + ((or (string= (getf item :variable) "subj3") + (string= (getf item :variable) "obj4")) + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "<http://some.where/tmsparql/author/goethe>"))) + ((string= (getf item :variable) "pred6") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-role* ">")))) + ((string= (getf item :variable) "subj6") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "<http://some.where/ii/association>"))) + ((string= (getf item :variable) "pred7") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (list (concat "<" *tms-player* ">") + (concat "<" *tms-scope* ">") + (concat "<" *instance-psi* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj7") + (is (= (length (getf item :result)) 3)) + (is (find "<http://psi.topicmaps.org/tmcl/scope-type>" + (getf item :result) :test #'string=)) + (is (find "<http://some.where/ii/goethe-variant>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "pred8") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (list (concat "<" *tms-player* ">") + (concat "<" *tms-reifier* ">") + (concat "<" *instance-psi* ">")) + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj8") + (is (= (length (getf item :result)) 3)) + (set-exclusive-or + (list "http://some.where/tmsparql/reifier-type" + (concat + "_:r" + (write-to-string + (elephant::oid + (first + (player-in-roles + (get-item-by-item-identifier + "http://some.where/ii/role-reifier" + :revision 0) :revision 0)))))) + (getf item :result) :test #'string=)))) + r-1)))) + + + + -;TODO: complex filter, -; complex relations between variables -; ?subj ?pred <obj> +;TODO: test complex filters, +; test complex relations between variables ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/> ; SELECT * WHERE { ; ?assoc tms:reifier <http://some.where/ii/association-reifier>.

1 0

[isidorus-cvs] r410 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 03 Apr '11

03 Apr '11

Author: lgiessmann Date: Sun Apr 3 15:56:15 2011 New Revision: 410 Log: TM-SPARQL: fixed a bug in the processing of final results when making intersections of all triples containing the same variable; finished the unit-tests for triples of the form <subj> ?var1 ?var2 Modified: trunk/src/TM-SPARQL/sparql.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 Sun Apr 3 15:56:15 2011 @@ -576,10 +576,11 @@ (pred-uri (when-do top (instance-of char :revision revision) (sparql-node top :revision revision)))) - (list :subject subj-uri - :predicate pred-uri - :object (charvalue char) - :literal-datatype literal-datatype))) + (when (and subj-uri pred-uri) + (list :subject subj-uri + :predicate pred-uri + :object (charvalue char) + :literal-datatype literal-datatype)))) (remove-if #'(lambda(char) (typep char 'VariantC)) (return-characteristics literal-value literal-datatype))))) @@ -602,13 +603,14 @@ 2) (find-if #'(lambda(r) (not (eql r role))) (roles assoc :revision revision)))))) - (list :subject - (when-do plr (player orole :revision revision) - (sparql-node plr :revision revision)) - :predicate - (when-do type (instance-of role :revision revision) - (sparql-node type :revision revision)) - :object obj-uri))) + (when orole + (list :subject + (when-do plr (player orole :revision revision) + (sparql-node plr :revision revision)) + :predicate + (when-do type (instance-of role :revision revision) + (sparql-node type :revision revision)) + :object obj-uri)))) roles-by-oplayer))))) @@ -664,15 +666,16 @@ (find-if #'(lambda(r) (not (eql r role))) (roles assoc :revision revision))))) - (list :subject - (when-do plr (player orole :revision revision) - (sparql-node plr :revision revision)) - :predicate - (sparql-node (value (predicate construct)) - :revision revision) - :object - (when-do plr-top (player role :revision revision) - (sparql-node plr-top :revision revision))))) + (when (and orole assoc) + (list :subject + (when-do plr (player orole :revision revision) + (sparql-node plr :revision revision)) + :predicate + (sparql-node (value (predicate construct)) + :revision revision) + :object + (when-do plr-top (player role :revision revision) + (sparql-node plr-top :revision revision)))))) roles-by-player)))))) @@ -711,14 +714,16 @@ (remove-null (map 'list #'(lambda(name) - (list :subject - (when-do top (parent name :revision revision) - (sparql-node top :revision revision)) - :predicate - (when-do top (instance-of name :revision revision) - (sparql-node top :revision revision)) - :object (charvalue name) - :literal-datatype *xml-string*)) + (when (and (parent name :revision revision) + (instance-of name :revision revision)) + (list :subject + (sparql-node (parent name :revision revision) + :revision revision) + :predicate + (sparql-node (instance-of name :revision revision) + :revision revision) + :object (charvalue name) + :literal-datatype *xml-string*))) names-by-literal)))))) @@ -748,14 +753,16 @@ (remove-null (map 'list #'(lambda(occ) - (list :subject - (when-do top (parent occ :revision revision) - (sparql-node top :revision revision)) - :predicate - (when-do top (instance-of occ :revision revision) - (sparql-node top :revision revision)) - :object (charvalue occ) - :literal-datatype (datatype occ))) + (when (and (parent occ :revision revision) + (instance-of occ :revision revision)) + (list :subject + (sparql-node (parent occ :revision revision) + :revision revision) + :predicate + (sparql-node (instance-of occ :revision revision) + :revision revision) + :object (charvalue occ) + :literal-datatype (datatype occ)))) all-occs)))))) @@ -771,9 +778,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 @@ -937,13 +944,13 @@ (subj-uri (sparql-node construct :revision revision))) (remove-null (map 'list #'(lambda(occ) - (list :subject subj-uri - :predicate - (when-do type-top - (instance-of occ :revision revision) - (sparql-node type-top :revision revision)) - :object (charvalue occ) - :literal-datatype (datatype occ))) + (when (instance-of occ :revision revision) + (list :subject subj-uri + :predicate (sparql-node + (instance-of occ :revision revision) + :revision revision) + :object (charvalue occ) + :literal-datatype (datatype occ)))) all-occs))))) @@ -968,15 +975,15 @@ (names construct :revision revision))) (all-names (intersection by-type by-literal)) (subj-uri (sparql-node construct :revision revision))) - (remove-null - (map 'list #'(lambda(name) - (list :subject subj-uri - :predicate - (when-do type-top (instance-of name :revision revision) - (sparql-node type-top :revision revision)) - :object (charvalue name) - :literal-datatype *xml-string*)) - all-names))))) + (map 'list #'(lambda(name) + (when (instance-of name :revision revision) + (list :subject subj-uri + :predicate (sparql-node + (instance-of name :revision revision) + :revision revision) + :object (charvalue name) + :literal-datatype *xml-string*))) + all-names)))) (defgeneric filter-characteristics (construct type-top literal-value @@ -1037,9 +1044,10 @@ (when-do player-top (player other-role :revision revision) (sparql-node player-top :revision revision))))) - (list :subject subj-uri - :predicate pred-uri - :object obj-uri)))) + (when (and subj-uri pred-uri obj-uri) + (list :subject subj-uri + :predicate pred-uri + :object obj-uri))))) assocs))))) @@ -1065,6 +1073,8 @@ (remove-null (loop for triple in (select-group construct) append (remove-null + ;;TODO: replace remove-null by a function that check if any of the + ;; list items is nil, if so the entire list should be nil (list (when (variable-p (subject triple)) (list :variable (value (subject triple)) @@ -1102,7 +1112,7 @@ (defgeneric variable-intersection (variable-name result-lists) (:documentation "Returns a list with all results of the passed variable that are contained in the result-lists. All results is - an intersection of all paratial results.") + an intersection of all partial results.") (:method ((variable-name String) (result-lists List)) (let* ((all-values (results-for-variable variable-name result-lists)) (list-1 (when (>= (length all-values) 1) @@ -1135,7 +1145,7 @@ (:method ((construct SPARQL-Query) (result-lists List)) (map 'list #'(lambda(triple) (reduce-triple triple result-lists)) - (select-group construct)))) + (select-group construct)))) (defgeneric reduce-triple(construct result-lists) @@ -1155,6 +1165,7 @@ intersections)))) + (defgeneric delete-rows (construct variable-name dont-touch-values) (:documentation "Checks all results of the passed variable of the given construct and deletes every result with the corresponding @@ -1173,17 +1184,15 @@ (object-result construct))))) (when var-elem (let* ((rows-to-hold - (remove-null - (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))) + (loop for idx to (max 0 (1- (length var-elem))) + when (cond + ((stringp (elt var-elem idx)) + (find (elt var-elem idx) dont-touch-values :test #'string=)) + ((numberp (elt var-elem idx)) + (find (elt var-elem idx) dont-touch-values :test #'=)) + (t + (find (elt var-elem idx) dont-touch-values))) + collect idx)) (new-result-list (map 'list #'(lambda(row-idx) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Apr 3 15:56:15 2011 @@ -16,7 +16,8 @@ :unittests-constants :fixtures :d - :constants) + :constants + :tm-sparql-constants) (:export :run-sparql-tests :sparql-tests :test-prefix-and-base @@ -2075,14 +2076,105 @@ "}")) (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)))) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "pred1") + ;one name without a type so it is not listed + (is (= (length (getf item :result)) 9))) + ((string= (getf item :variable) "pred2") + (is (= (length (getf item :result)) 3)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-role* ">") + (concat "<" *tms-reifier* ">")) + :test #'string=))) + ((string= (getf item :variable) "pred3") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-player* ">")))) + ((string= (getf item :variable) "pred4") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + (concat "<" *tms-value* ">")))) + ((string= (getf item :variable) "pred5") + (is (= (length (getf item :result)) 2)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-value* ">") + (concat "<" *tms-reifier* ">")) + :test #'string=))) + ((string= (getf item :variable) "pred6") + (is (= (length (getf item :result)) 2)) + (is-false (set-exclusive-or + (getf item :result) + (list (concat "<" *tms-value* ">") + (concat "<" *tms-scope* ">")) + :test #'string=))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 9)) + (is-false (set-exclusive-or + (getf item :result) + (list "Johann Wolfgang" "von Goethe" + "28.08.1749" "22.03.1832" "82" + "true" "false" + "<http://some.where/tmsparql/author>" + "<http://some.where/psis/poem/zauberlehrling>") + :test #'string=))) + ((string= (getf item :variable) "obj2") + (is (= (length (getf item :result)) 3)) + (is-false + (set-exclusive-or + (getf item :result) + (list + "<http://some.where/ii/association-reifier>" + "<http://some.where/ii/role-2>" + (concat + "_:r" + (write-to-string + (elephant::oid + (loop for role in + (roles + (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0)) + when (string= + (uri (first (psis (player role + :revision 0)))) + "http://some.where/tmsparql/author/goethe") + return role))))) + :test #'string=))) + ((string= (getf item :variable) "obj3") + (is (= (length (getf item :result)) 1)) + (is (string= + (first (getf item :result)) + "<http://some.where/psis/poem/zauberlehrling>"))) + ((string= (getf item :variable) "obj4") + (is (= (length (getf item :result)) 1)) + (is (string= (first (getf item :result)) + "Johann Wolfgang von Goethe"))) + ((string= (getf item :variable) "obj5") + (is (= (length (getf item :result)) 2)) + (is-false + (set-exclusive-or + (getf item :result) + (list "28.08.1749" + "<http://some.where/ii/goethe-occ-reifier>") + :test #'string=))) + ((string= (getf item :variable) "obj6") + (is (= (length (getf item :result)) 2)) + (is-false + (set-exclusive-or + (getf item :result) + (list "Goethe" + "<http://some.where/tmsparql/display-name>") + :test #'string=))) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) ;TODO: complex filter, ; complex relations between variables -; <subj> ?pred ?obj, ; ?subj ?pred <obj> ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/> ; SELECT * WHERE {

1 0

[isidorus-cvs] r409 - trunk/src/TM-SPARQL
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 15:10:07 2011 New Revision: 409 Log: TM-SPARQL: fixed a bug in the macro with-triple-nodes that appears with the latest changes with special-uris Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp 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 15:10:07 2011 @@ -18,12 +18,15 @@ `(let* ((subj (subject ,triple-construct)) (pred (predicate ,triple-construct)) (obj (object ,triple-construct)) - (subj-uri (unless (variable-p subj) + (subj-uri (when (and (not (variable-p subj)) + (value subj)) (sparql-node (value subj) :revision revision))) - (pred-uri (unless (variable-p pred) + (pred-uri (when (and (not (variable-p pred)) + (value pred)) (sparql-node (value pred) :revision revision))) (obj-uri (when (and (not (variable-p obj)) - (not (literal-p obj))) + (not (literal-p obj)) + (value obj)) (sparql-node (value obj) :revision revision))) (literal-datatype (when (literal-p obj) (literal-datatype obj)))) @@ -386,7 +389,7 @@ (get-all-topics revision))))) (loop for top in topics collect (list :subject - (sparql-node (reified-construct top :revision revision) - :revision revision) - :predicate pred-uri - :object (sparql-node top :revision revision))))))))))) \ No newline at end of file + (sparql-node (reified-construct top :revision revision) + :revision revision) + :predicate pred-uri + :object (sparql-node top :revision revision))))))))))) \ No newline at end of file

1 0

[isidorus-cvs] r408 - trunk/src/unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 14:36:47 2011 New Revision: 408 Log: fixed a svn problem Modified: trunk/src/unit_tests/sparql_test.lisp 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 14:36:47 2011 @@ -2075,6 +2075,7 @@ "}")) (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))))

1 0

[isidorus-cvs] r407 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

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,

1 0

[isidorus-cvs] r406 - in trunk/src: model unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 11:45:32 2011 New Revision: 406 Log: TM-SPARQL: finsihed the unit-tests for the special-uri of the form ?var1 <pred> ?var2 => fixed a bug in get-db-instances-by-class Modified: trunk/src/model/datamodel.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Apr 1 11:45:32 2011 @@ -751,7 +751,8 @@ (if revision (remove-null (map 'list #'(lambda(inst) - (if (typep inst 'CHaracteristicC) + (if (or (typep inst 'CharacteristicC) + (typep inst 'RoleC)) (find-item-by-revision inst revision (parent inst :revision revision)) (find-item-by-revision inst 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 11:45:32 2011 @@ -1852,7 +1852,8 @@ "<http://some.where/tmsparql/author/goethe>"))) ((string= (getf item :variable) "props") (is (= (length (getf item :result)) 8)) - (is-false (intersection prop-ids (getf item :result)))) + (is-false (set-exclusive-or prop-ids (getf item :result) + :test #'string=))) (t (is-true (format t "bad variable-name found"))))) r-1)))) @@ -1945,10 +1946,123 @@ (is-false r-1)))) +(test test-all-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) + (let* ((q-1 (concat + "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> + SELECT * WHERE { + ?subj1 a ?obj1. + ?subj2 tms:reifier ?obj2. + ?subj3 tms:role ?obj3. + ?subj4 tms:player ?obj4. + ?subj5 tms:topicProperty ?obj5. + ?subj6 tms:scope ?obj6. + ?subj7 tms:value ?obj7" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is (= (length r-1) 14)) + (map 'list #'(lambda(item) + (cond ((string= (getf item :variable) "subj1") + (is (= (length (getf item :result)) 29))) + ((string= (getf item :variable) "obj2") + (is (= (length (getf item :result)) 4)) + (is-false (set-exclusive-or + (getf item :result) + (list "<http://some.where/ii/goethe-name-reifier>" + "<http://some.where/ii/goethe-occ-reifier>" + "<http://some.where/ii/association-reifier>" + "<http://some.where/ii/role-reifier>") + :test #'string=))) + ((string= (getf item :variable) "subj3") + (is (= (length (getf item :result)) 60)) + (is (find "<http://some.where/ii/association>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "subj4") + (is (= (length (getf item :result)) 60))) + ((string= (getf item :variable) "subj5") + (is (= (length (getf item :result)) 10))) + ((string= (getf item :variable) "subj6") + (is (= (length (getf item :result)) 2)) + (set-exclusive-or + (getf item :result) + (list "<http://some.where/ii/zb/occurrence>" + "<http://some.where/ii/goethe-variant>") + :test #'string=)) + ((string= (getf item :variable) "subj7") + (is (= (length (getf item :result)) 11))) + ((string= (getf item :variable) "obj1") + (is (= (length (getf item :result)) 29))) + ((string= (getf item :variable) "subj2") + (is (= (length (getf item :result)) 4)) + (is-false + (set-exclusive-or + (getf item :result) + (list + "<http://some.where/ii/goethe-occ>" + "<http://some.where/ii/association>" + (concat + "_:r" + (write-to-string + (elephant::oid + (loop for role in + (roles (get-item-by-item-identifier + "http://some.where/ii/association" + :revision 0) :revision 0) + when (string= + (uri (first + (psis (player role :revision 0) + :revision 0))) + "http://some.where/tmsparql/author/goethe") + return role)))) + (concat + "_:n" + (write-to-string + (elephant::oid + (loop for name in + (names + (get-item-by-psi + "http://some.where/tmsparql/author/goethe" + :revision 0) :revision 0) + when (string= (charvalue name) "von Goethe") + return name))))) + :test #'string=))) + ((string= (getf item :variable) "obj3") + (is (= (length (getf item :result)) 60)) + (is (find "<http://some.where/ii/role-2>" + (getf item :result) :test #'string=))) + ((string= (getf item :variable) "obj4") + (is (= (length (getf item :result)) 60))) + ((string= (getf item :variable) "obj5") + (is (= (length (getf item :result)) 10))) + ((string= (getf item :variable) "obj6") + (is (= (length (getf item :result)) 2)) + (set-exclusive-or + (getf item :result) + (list "<http://some.where/tmsparql/display-name>" + "<http://some.where/tmsparql/de>"))) + ((string= (getf item :variable) "obj7") + (is (= (length (getf item :result)) 11)) + (set-exclusive-or + (getf item :result) + (list "Johann Wolfgang" "von Goethe" + "Johann Wolfgang von Goethe" "Der Zauberlehrling" + "28.08.1749" "22.03.1832" "82" "true" "false" + "Hat der alte Hexenmeister + sich doch einmal wegbegeben! + ... + ") + :test #'string=)) + (t + (is-true (format t "bad variable-name found"))))) + r-1)))) + + ;TODO: complex filter, -; ?obj <pred> ?subj, +; complex relations between variables ; <subj> ?pred ?obj, ; ?subj ?pred <obj> ;TODO: PREFIX tms:<http://www.networkedplanet.com/tmsparql/>

1 0

[isidorus-cvs] r405 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 01 Apr '11

01 Apr '11

Author: lgiessmann Date: Fri Apr 1 10:40:07 2011 New Revision: 405 Log: TM-SPARQL: finsihed the unit-tests for the special-uri of the form <subj> <pred> <obj> => fixed a bug with names playing the role of object-resources 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 10:40:07 2011 @@ -780,7 +780,9 @@ subj pred (value (object construct)) (literal-datatype (object construct)) :revision revision))) ((and (iri-p (object construct)) - (typep subj 'TopicC)) + (typep subj 'TopicC) + (or (variable-p (object construct)) + (typep (value (object construct)) '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 10:40:07 2011 @@ -253,14 +253,19 @@ (literal-p obj))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) - (when (or (and (typep subj 'NameC) - (string= literal-datatype *xml-string*) + (if (typep (value subj) 'NameC) + (when (and (string= literal-datatype *xml-string*) (string= (charvalue (value subj)) (value obj))) - (filter-datatypable-by-value subj obj literal-datatype)) - (list (list :subject subj-uri - :predicate pred-uri - :object (value obj) - :literal-datatype literal-datatype)))) + (list (list :subject subj-uri + :predicate pred-uri + :object (value obj) + :literal-datatype literal-datatype))) + (when (filter-datatypable-by-value (value subj) (value obj) + literal-datatype) + (list (list :subject subj-uri + :predicate pred-uri + :object (value obj) + :literal-datatype literal-datatype))))) ((not (variable-p subj)) (list (list :subject subj-uri :predicate pred-uri 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 10:40:07 2011 @@ -1926,9 +1926,28 @@ r-1)))) +(test test-all-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) + (let* ((q-1 (concat + "PREFIX tms:<http://www.networkedplanet.com/tmsparql/> + SELECT * WHERE { + <http://some.where/tmsparql/author/goethe> a <http://some.where/tmsparql/author>. + <http://some.where/ii/goethe-occ> tms:reifier <http://some.where/ii/goethe-occ-reifier>. + <http://some.where/ii/association> tms:role <http://some.where/ii/role-2>. + <http://some.where/ii/role-2> tms:player <http://some.where/psis/poem/zauberlehrling>. + <http://some.where/tmsparql/author/goethe> tms:topicProperty <http://some.where/ii/goethe-untyped-name>. + <http://some.where/ii/goethe-variant> tms:scope <http://some.where/tmsparql/display-name>. + <http://some.where/ii/goethe-untyped-name> tms:value 'Johann Wolfgang von Goethe'" + "}")) + (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) + (is-false r-1)))) -;TODO: tms:value, complex filter, -; <obj> <pred> <subj>, + + + +;TODO: complex filter, ; ?obj <pred> ?subj, ; <subj> ?pred ?obj, ; ?subj ?pred <obj>

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

isidorus-cvs