Skip to content
Snippets Groups Projects
Unverified Commit ee44e6e3 authored by Eric Timmons's avatar Eric Timmons
Browse files

Make junit reporting a bit better

parent 21aae5a9
No related branches found
No related tags found
No related merge requests found
Pipeline #6095 passed
......@@ -12,6 +12,19 @@
(defun duration-to-xml (duration)
(format nil "~f" duration))
(defgeneric failed-p (result)
(:method ((result para:result))
(eql :failed (para:status result)))
(:method ((result para:controlling-result))
(eql :failed (para:child-status result))))
(defgeneric skipped-p (result)
(:method ((result para:result))
(eql :skipped (para:status result)))
(:method ((result para:controlling-result))
(eql :skipped (para:child-status result))))
(defgeneric make-junit-node (result &key class-name))
(defmethod make-junit-node ((result para:test-result) &key class-name)
......@@ -20,8 +33,8 @@
(child-results (remove-if (lambda (x) (typep x 'para:test-result))
(para:results result)))
(num-tests (length child-results))
(num-failures (count :failed child-results :key 'para:status))
(num-skipped (count :skipped child-results :key 'para:status))
(num-failures (count-if #'failed-p child-results))
(num-skipped (count-if #'skipped-p child-results))
(name (result-name result))
(class-name (format nil "~@[~a.~]~a" class-name name)))
(xmls:make-node
......@@ -42,9 +55,25 @@
(defun result-name (result)
(let ((expression (para:expression result)))
(if (typep expression 'para:test)
(para:name expression)
(format nil "~a" expression))))
(cond
((typep expression 'para:test)
(para:name expression))
;; ((typep result 'para:controlling-result)
;; (format nil "~a" (para:body result)))
(t
(or (para:description result)
(format nil "~a" expression))))))
;; (defgeneric reason (result))
;; (defmethod reason ((result para:test-result))
;; (para:description result))
;; (defmethod reason ((result para:controlling-result))
;; (para:description result))
;; (defmethod reason ((result para:result))
;; )
(defmethod make-junit-node ((result para:result) &key class-name)
(xmls:make-node
......@@ -56,9 +85,27 @@
(:passed
nil)
(:skipped
(xmls:make-node :name "skipped"))
(xmls:make-node :name "skipped"
:child (para:format-result result :extensive)))
(:failure
(xmls:make-node :name "failure"
:child (para:format-result result :extensive))))))
(defmethod make-junit-node ((result para:controlling-result) &key class-name)
(xmls:make-node
:name "testcase"
:attrs `(("classname" ,class-name)
("name" ,(result-name result))
("time" ,(duration-to-xml (para:duration result))))
:child (ecase (para:child-status result)
(:passed
nil)
(:skipped
(xmls:make-node :name "skipped"
:child (para:format-result result :extensive)))
(:failure
(xmls:make-node :name "failure")))))
(xmls:make-node :name "failure"
:child (para:format-result result :extensive))))))
(defmethod make-junit-node :after (result &key class-name)
(declare (ignore class-name))
......@@ -71,6 +118,7 @@
(defmethod para:summarize ((report junit-report))
(let ((*processed-results* (make-hash-table))
(*print-case* :downcase)
(pathname (slot-value report 'pathname)))
(ensure-directories-exist pathname)
(with-open-file (s pathname :direction :output :if-exists :supersede)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment