Skip to content
Permalink
Browse files

Fixed errors in test results comparisons. Now 458 test succeed

  • Loading branch information...
Esko Nuutila Esko Nuutila
Esko Nuutila authored and Esko Nuutila committed Jun 4, 2015
1 parent 63504fc commit 95725a6a2814fd33ca46522e80cf3506bc0c1ae6
8 TODO
@@ -1,3 +1,11 @@
- 2015-06-03
- If select results are written as ttl, be sure to write the variables
- Will fix algebra/filter-nested-2 and algebra/opt-filter-2, join-scope-1
- Prefix : missing from results, even though it is defined in rules. Should we add the definition from rules?
- Variable name case: should we keep the case in the SPARQL file and test not case sensitive, or what?
+ Maybe change eat-var-name NOT TO upcase string + add print-name to uniquely-named-object and upcase the name for comparison.
- Will fix boolean-effective-value tests except for one of them

- Check that ?s ?p ?p works properly
- Change (AS var expr) to (AS expr var)
- Aquamacs home directory
@@ -1,3 +1,8 @@
- Add initialization of pretty-name where needed
- Change calls of uniquely-named-object-name to uniquely-named-object-pretty-name when appropriate
+ Add field pretty-name to uniquely-named-object-name
- Change eat-var-name NOT TO upcase string + add print-name to uniquely-named-object and upcase the name for comparison.

- Fix field labeling sparql-tests.csv headers vs. class fields
- Make methods for testing
+ Success/failure handling
@@ -79,7 +79,7 @@
(defun instans-add-rules (instans rules &key base (output-options-stream nil))
(instans-debug-message instans :parse-rules "instans-add-rules ~S ~S :base ~S" (instans-name instans) rules base)
(when output-options-stream
(format output-options-stream "--rules=~A" rules))
(format output-options-stream " --rules=~A" rules))
(cond ((sparql-error-p instans) nil)
(t
(let ((string (cond ((file-or-uri-exists-p rules)
@@ -135,7 +135,7 @@
(defun instans-add-stream-input-processor (instans input-iri &key graph base input-type subscribe (output-options-stream nil))
(instans-debug-message instans '(:parse-rdf :execute) "instans-add-stream-input-processor ~S ~S :input-type ~S :graph ~S :base ~S" (instans-name instans) input-iri input-type graph base)
(when output-options-stream
(format output-options-stream "~@[--graph=~A ~]~@[--base=~A ~]--input-~(~A~)=~A" (and graph (rdf-iri-string graph)) (and base (rdf-iri-string base)) input-type input-iri))
(format output-options-stream " ~@[--graph=~A ~]~@[--base=~A ~]--input-~(~A~)=~A" (and graph (rdf-iri-string graph)) (and base (rdf-iri-string base)) input-type input-iri))
(multiple-value-bind (processor-type parser-creator)
(case input-type
(:trig (values 'instans-trig-input-processor #'make-trig-parser))
@@ -301,6 +301,11 @@
:usage "Write SELECT results in SPARQL XML result set format to OUTPUT."
(setf select-output-name value)
(setf select-output-type :srx))
(select-output-ttl
:options ("--select-output-ttl=OUTPUT")
:usage "Write SELECT results in TTL format to OUTPUT."
(setf select-output-name value)
(setf select-output-type :ttl))
(construct-output
:options ("--construct-output=FILE")
:usage "Write CONSTRUCT results to FILE. Output format is based on the file name suffix."
@@ -446,7 +451,7 @@
"various outputs and names during the execution of INSTANS, but the name does"
"not bear any actual semantics.")
(setf (instans-name instans) value))
(reporting
(report
:options ("--report=KINDS")
:usage ("The kinds of rules you want to get reported; a ':' separated list of"
"(select|construct|modify|all|rete-add|rete-remove|queue|rdf-operations|execute|memoryN|memoriesN)."
@@ -455,14 +460,14 @@
:hiddenp t
(setf reporting (loop for kind in (parse-colon-separated-values value)
when (eq kind :all)
append '(:select :construct :modify :all :rete-add :rete-remove :queue :rdf-operations :execute)
append '(:select t :construct t :modify t :all t :rete-add t :rete-remove t :queue t :rdf-operations t :execute t)
else when (eql 0 (search "MEMORY" (string kind)))
append (prog1 (list :memory-summaries) (parse-integer (string kind) :start 6))
else when (eql 0 (search "MEMORIES" (string kind)))
append (prog1 (list :memory-sizes) (parse-integer (string kind) :start 8))
else append (list kind)))
(loop for kind in reporting
unless (member kind '(:select :construct :modify :rete-add :rete-remove :queue :call-succ-nodes :all :memory :memories :rdf-operations :execute))
else append (list kind t)))
(loop for tail on reporting by #'cddr
unless (member (first tail) '(:select :construct :modify :rete-add :rete-remove :queue :call-succ-nodes :all :memory :memories :rdf-operations :execute))
do (usage))
(initialize-reporting instans reporting))
(prefix-encoding
@@ -497,7 +502,6 @@
(run-sparql-conformance-tests
:options ("--run-sparql-conformance-tests==TEST_DIR")
:usage "Run sparql test suites. Test suites should be in TEST_DIR/suites. The result is written into TEST_DIR/suites/results.csv"
(inform "Value = ~S" value)
(run-sparql-test-suites value))
)
(unless executedp (execute))
@@ -238,7 +238,7 @@
(loop for ch = (peekch lexer)
while (var-name-other-char-p ch)
do (chbuf-put-char buf (get-char lexer))
finally (return-input-token lexer terminal-type (string-upcase (canonize-string lexer buf)))))
finally (return-input-token lexer terminal-type (canonize-string lexer buf))))

(defun get-char-if-looking-at-with-eof-error (lexer ch eof-fmt &rest args)
(cond ((null (peekch lexer))
@@ -174,7 +174,7 @@
(translate-variable (args orig-form)
(let ((name-elem (first (first args))))
(unless (string= (first name-elem) "name") (srx-error "Illegal variable:~%translated ~S~%parsed ~S" args orig-form))
(make-sparql-var instans (format nil "?~A" (string-upcase (second name-elem))))))
(make-sparql-var instans (format nil "?~A" (second name-elem)))))
(translate-link (args orig-form)
(let ((href-elem (first (first args))))
(unless (string= (first href-elem) "href") (srx-error "Illegal link:~%translated ~S~%parsed ~S" args orig-form))
@@ -188,9 +188,7 @@
(translate-binding (args orig-form)
(let ((name-elem (first (first args))))
(unless (string= (first name-elem) "name") (srx-error "Illegal binding:~%translated ~S~%parsed ~S" args orig-form))
(let ((name (second name-elem))
(value (second args)))
(create-sparql-binding (make-sparql-var instans (format nil "?~A" (string-upcase name))) value))))
(create-sparql-binding (make-sparql-var instans (format nil "?~A" (second name-elem))) (second args))))
(translate-bnode (args orig-form)
(declare (ignorable orig-form))
(cond ((null (first args))
@@ -37,7 +37,7 @@
(:method ((this minus-node)) (dot-default-pretty-name-format "-"))
(:method ((this filter-node)) (dot-default-pretty-name-format "F"))
(:method ((this filter-memory)) (dot-default-pretty-name-format "FM"))
(:method ((this bind-node)) (dot-default-pretty-name-format (format nil "B[~A]" (uniquely-named-object-name (bind-variable this)))))
(:method ((this bind-node)) (dot-default-pretty-name-format (format nil "B[~A]" (uniquely-named-object-pretty-name (bind-variable this)))))
(:method ((this aggregate-join-node)) (dot-default-pretty-name-format "AJ"))
(:method ((this select-node)) (dot-default-pretty-name-format "S"))
(:method ((this construct-node)) (dot-default-pretty-name-format "C"))
@@ -49,7 +49,7 @@

(defun dot-pretty-triple-pattern (node)
(format nil "~{~a~^ ~}" (mapcar #'(lambda (x) (cond ((sparql-var-p x)
(string-downcase (string (uniquely-named-object-name (reverse-resolve-binding (node-instans node) x)))))
(string-downcase (string (uniquely-named-object-pretty-name (reverse-resolve-binding (node-instans node) x)))))
((or (rdf-iri-p x) (rdf-literal-p x))
(html-entities:encode-entities (sparql-value-to-string x :instans (node-instans node))))
(t x)))
@@ -118,7 +118,7 @@
(loop for var in canonic-vars
; do (inform "var = ~S" var)
unless (null var)
collect (uniquely-named-object-name (car (rassoc var alist))))))
collect (uniquely-named-object-pretty-name (car (rassoc var alist))))))

(defgeneric dot-node-tooltip (node)
(:method ((this node))
@@ -219,7 +219,7 @@
(bindings (with-output-to-string (str)
(format str "Bindings:")
(loop for (from . to) in (instans-bindings instans)
do (format str "~% ~A -> ~A" (uniquely-named-object-name from) (uniquely-named-object-name to)))))
do (format str "~% ~A -> ~A" (uniquely-named-object-pretty-name from) (uniquely-named-object-pretty-name to)))))
(sparql-algebra (with-output-to-string (str)
(loop for expr in (instans-canonic-algebra-expr-list instans)
; do (inform "algebra-expr:~%~A" expr)
@@ -248,7 +248,7 @@
(xml-emitter:with-tag ("head")
(when (slot-boundp this 'variables)
(loop for variable in (sparql-query-results-variables this)
do (xml-emitter:with-simple-tag ("variable" `(("name" ,(format nil "~(~A~)" (subseq (uniquely-named-object-name variable) 1)))))))
do (xml-emitter:with-simple-tag ("variable" `(("name" ,(format nil "~(~A~)" (subseq (uniquely-named-object-pretty-name variable) 1)))))))
(when (slot-boundp this 'links)
(loop for link in (sparql-query-results-links this)
do (xml-emitter:with-simple-tag ("link" `(("href" ,(sparql-link-href link )))))))))
@@ -264,7 +264,7 @@
when binding
do (let ((value (sparql-binding-value binding)))
(unless (sparql-unbound-p value)
(xml-emitter:with-tag ("binding" `(("name" ,(format nil "~(~A~)" (subseq (uniquely-named-object-name variable) 1)))))
(xml-emitter:with-tag ("binding" `(("name" ,(format nil "~(~A~)" (subseq (uniquely-named-object-pretty-name variable) 1)))))
(cond ((sparql-error-p value)
; (inform "outputting ~S" value)
(xml-emitter:simple-tag "literal" "SPARQL-ERROR"))
@@ -285,8 +285,8 @@
;(inform "writing plain literal ~A~%" (rdf-literal-string value))
(xml-emitter:simple-tag "literal" (rdf-literal-string value)))))
((rdf-blank-node-p value)
;(inform "writing blank ~A~%" (uniquely-named-object-name value))
(xml-emitter:with-simple-tag ("bnode") (xml-emitter:xml-as-is (uniquely-named-object-name value))))
;(inform "writing blank ~A~%" (uniquely-named-object-pretty-name value))
(xml-emitter:with-simple-tag ("bnode") (xml-emitter:xml-as-is (uniquely-named-object-pretty-name value))))
((typep value 'datetime)
(xml-emitter:with-tag ("literal" (list (list "datatype" *xsd-datetime-iri-string*)))
(xml-emitter:xml-as-is (datetime-canonic-string value))))
@@ -303,16 +303,15 @@
(format stream "@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
@prefix rs: <http://www.w3.org/2001/sw/DataAccess/tests/result-set#> .
@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
@prefix : <http://example.org/things#> .
[] rdf:type rs:ResultSet ;
~{rs:resultVariable \"~A\" ;~^~% ~}
~{rs:solution [ ~{ rs:binding ~{ [ rs:variable \"~A\"; rs:value ~A ]~}~^;~% ~}
];~^~% ~} .~%"
(mapcar #'(lambda (v) (subseq (uniquely-named-object-name v) 1)) (sparql-query-results-variables this))
(mapcar #'(lambda (v) (subseq (uniquely-named-object-pretty-name v) 1)) (sparql-query-results-variables this))
(mapcar #'(lambda (solution) (mapcan #'(lambda (b)
(and (not (sparql-unbound-p (sparql-binding-value b)))
(list (list (subseq (uniquely-named-object-name (sparql-binding-variable b)) 1)
(list (list (subseq (uniquely-named-object-pretty-name (sparql-binding-variable b)) 1)
(sparql-value-to-string (sparql-binding-value b))))))
(sparql-result-bindings solution)))
(slot-value-with-default this 'results nil)
@@ -340,7 +339,7 @@
(unless (instans-writer-append-p this)
(write-csv-headers (instans-csv-writer-csv-output this)
(mapcar #'(lambda (var)
(format nil "~(~A~)" (subseq (uniquely-named-object-name var) 1)))
(format nil "~(~A~)" (subseq (uniquely-named-object-pretty-name var) 1)))
variables))))
(:method ((this instans-sparql-query-results-writer) variables)
(set-query-variables (instans-sparql-query-results-writer-results this) variables)))
@@ -1034,7 +1034,7 @@
(rule-instance-queue-modify-count queue)))

(defun operation-report-p (instans kind)
(member kind (instans-report-operation-kinds instans)))
(getf (instans-report-operation-kinds instans) kind))

(defgeneric rule-node-name-pretty (rule-node)
(:method ((this rule-node))
@@ -86,15 +86,15 @@

(defgeneric make-named-blank-node (instans name)
(:method ((this instans) name)
(make-uniquely-named-object (instans-named-blank-node-factory this) name)))
(make-uniquely-named-object (instans-named-blank-node-factory this) (string-upcase name) :pretty-name name)))

(defgeneric generate-anonymous-blank-node (instans)
(:method ((this instans))
(generate-object-with-unique-name (instans-anonymous-blank-node-factory this) :name-prefix "_:")))

(defgeneric make-sparql-var (instans name)
(:method ((this instans) name)
(make-uniquely-named-object (instans-var-factory this) name)))
(make-uniquely-named-object (instans-var-factory this) (string-upcase name) :pretty-name name)))

(defgeneric generate-sparql-var (instans &optional name-prefix)
(:method ((this instans) &optional name-prefix)
@@ -49,7 +49,8 @@
(value :accessor rdf-literal-value :initarg :value)))

(define-class uniquely-named-object ()
((name :accessor uniquely-named-object-name :initarg :name)))
((name :accessor uniquely-named-object-name :initarg :name)
(pretty-name :accessor uniquely-named-object-pretty-name :initarg :pretty-name :initform nil)))

(define-class rdf-blank-node (rdf-term uniquely-named-object) ())

@@ -114,6 +115,9 @@
(when descriptor
(setf (rdf-literal-value this) (funcall (type-descriptor-value-parser descriptor) (rdf-literal-string this)))))))))

(defmethod initialize-instance :after ((this uniquely-named-object) &key pretty-name &allow-other-keys)
(unless pretty-name (setf (uniquely-named-object-pretty-name this) (uniquely-named-object-name this))))

;;; END initialize-instance :after

;;; BEGIN print-object
@@ -133,7 +137,7 @@
(format stream ">"))

(defmethod print-object ((this uniquely-named-object) stream)
(format stream "#<~A ~A>" (type-of this) (uniquely-named-object-name this)))
(format stream "#<~A ~A>" (type-of this) (uniquely-named-object-pretty-name this)))

(defmethod print-object ((this sparql-op) stream)
(format stream "#<~A ~:[~;hidden ~]\"~A\" (~{~A~^ ~}) returns ~A>"
@@ -220,10 +224,10 @@
(or (eq o1 o2)
(equal (uniquely-named-object-name o1) (uniquely-named-object-name o2)))))

(defgeneric make-uniquely-named-object (factory name &rest keys &key &allow-other-keys)
(:method ((factory uniquely-named-object-factory) name &rest keys &key &allow-other-keys)
(defgeneric make-uniquely-named-object (factory name &rest keys &key pretty-name &allow-other-keys)
(:method ((factory uniquely-named-object-factory) name &rest keys &key pretty-name &allow-other-keys)
(or (gethash name (slot-value factory 'objects-by-name))
(let ((object (apply #'make-instance (slot-value factory 'object-type) :name name keys)))
(let ((object (apply #'make-instance (slot-value factory 'object-type) :name name :pretty-name pretty-name keys)))
(setf (gethash name (slot-value factory 'objects-by-name)) object)
object))))

@@ -132,7 +132,7 @@
(defgeneric print-sparql-results (sparql-query-results &key stream)
(:method ((this sparql-query-results) &key (stream *standard-output*))
(when (slot-boundp this 'variables)
(format stream "Variables: ~{~A~^ ~}~%" (mapcar #'(lambda (var) (subseq (uniquely-named-object-name var) 1)) (sparql-query-results-variables this))))
(format stream "Variables: ~{~A~^ ~}~%" (mapcar #'(lambda (var) (subseq (uniquely-named-object-pretty-name var) 1)) (sparql-query-results-variables this))))
(when (slot-boundp this 'links)
(format stream "Links: ~{~A~^ ~}~%" (mapcar #'(lambda (link) link) (sparql-query-results-links this))))
(when (slot-boundp this 'boolean)

0 comments on commit 95725a6

Please sign in to comment.
You can’t perform that action at this time.