From ee44e6e30a2074849af51199f99813141454e89c Mon Sep 17 00:00:00 2001 From: Eric Timmons <etimmons@mit.edu> Date: Thu, 24 Feb 2022 13:26:25 -0500 Subject: [PATCH] Make junit reporting a bit better --- test/report.lisp | 62 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 55 insertions(+), 7 deletions(-) diff --git a/test/report.lisp b/test/report.lisp index 977681c..46086f2 100644 --- a/test/report.lisp +++ b/test/report.lisp @@ -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) -- GitLab