Function: ert-write-junit-test-report

ert-write-junit-test-report is a byte-compiled function defined in ert.el.gz.

Signature

(ert-write-junit-test-report STATS)

Documentation

Write a JUnit test report, generated from STATS.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/ert.el.gz
(defun ert-write-junit-test-report (stats)
  "Write a JUnit test report, generated from STATS."
  ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format
  ;; https://llg.cubic.org/docs/junit/
  (when-let* ((symbol (car (apropos-internal "" #'ert-test-boundp)))
              (test-file (symbol-file symbol 'ert--test))
              (test-report
               (file-name-with-extension
                (or ert-load-file-name test-file) "xml")))
    (with-temp-file test-report
      (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
      (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
                      (file-name-nondirectory test-report)
                      (ert-stats-total stats)
                      (if (ert--stats-aborted-p stats) 1 0)
                      (ert-stats-completed-unexpected stats)
                      (ert-stats-skipped stats)
                      (float-time
                       (time-subtract
                        (ert--stats-end-time stats)
                        (ert--stats-start-time stats)))))
      (insert (format "  <testsuite id=\"0\" name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
                      (file-name-nondirectory test-report)
                      (ert-stats-total stats)
                      (if (ert--stats-aborted-p stats) 1 0)
                      (ert-stats-completed-unexpected stats)
                      (ert-stats-skipped stats)
                      (float-time
                       (time-subtract
                        (ert--stats-end-time stats)
                        (ert--stats-start-time stats)))
                      (ert--format-time-iso8601 (ert--stats-end-time stats))))
      ;; If the test has aborted, `ert--stats-selector' might return
      ;; huge junk.  Skip this.
      (when (< (length (format "%s" (ert--stats-selector stats))) 1024)
        (insert "    <properties>\n"
                (format "      <property name=\"selector\" value=\"%s\"/>\n"
                        (xml-escape-string
                         (format "%s" (ert--stats-selector stats)) 'noerror))
                "    </properties>\n"))
      (cl-loop for test across (ert--stats-tests stats)
               for result = (ert-test-most-recent-result test) do
               (insert (format "    <testcase name=\"%s\" status=\"%s\" time=\"%s\""
                               (xml-escape-string
                                (symbol-name (ert-test-name test)) 'noerror)
                               (ert-string-for-test-result
                                result
                                (ert-test-result-expected-p test result))
                               (ert-test-result-duration result)))
               (if (and (ert-test-result-expected-p test result)
                        (not (ert-test-aborted-with-non-local-exit-p result))
                        (not (ert-test-skipped-p result))
                        (zerop (length (ert-test-result-messages result))))
                   (insert "/>\n")
                 (insert ">\n")
                 (cond
                  ((ert-test-skipped-p result)
                   (insert (format "      <skipped message=\"%s\" type=\"%s\">\n"
                                   (xml-escape-string
                                    (string-trim
                                     (ert-reason-for-test-result result))
                                    'noerror)
                                   (ert-string-for-test-result
                                    result
                                    (ert-test-result-expected-p
                                     test result)))
                           (xml-escape-string
                            (string-trim
                             (ert-reason-for-test-result result))
                            'noerror)
                           "\n"
                           "      </skipped>\n"))
                  ((ert-test-aborted-with-non-local-exit-p result)
                   (insert (format "      <error message=\"%s\" type=\"%s\">\n"
                                   (file-name-nondirectory test-report)
                                   (ert-string-for-test-result
                                    result
                                    (ert-test-result-expected-p
                                     test result)))
                           (format "Test %s aborted with non-local exit\n"
                                   (xml-escape-string
                                    (symbol-name (ert-test-name test)) 'noerror))
                           "      </error>\n"))
                  ((not (ert-test-result-type-p
                         result (ert-test-expected-result-type test)))
                   (insert (format "      <failure message=\"%s\" type=\"%s\">\n"
                                   (xml-escape-string
                                    (string-trim
                                     (ert-reason-for-test-result result))
                                    'noerror)
                                   (ert-string-for-test-result
                                    result
                                    (ert-test-result-expected-p
                                     test result)))
                           (xml-escape-string
                            (string-trim
                             (ert-reason-for-test-result result))
                            'noerror)
                           "\n"
                           "      </failure>\n")))
                 (unless (zerop (length (ert-test-result-messages result)))
                   (insert "      <system-out>\n"
                           (xml-escape-string
                            (ert-test-result-messages result) 'noerror)
                           "      </system-out>\n"))
                 (insert "    </testcase>\n")))
      (insert "  </testsuite>\n")
      (insert "</testsuites>\n"))))