--- /dev/null
+;;; lunit-report.el --- output test report in XML compatible with JUnitTask
+
+;; Copyright (C) 2004 Daiki Ueno.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+
+;; This file is part of Riece.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'lunit)
+
+(eval-and-compile
+ (luna-define-class lunit-test-reporter (lunit-test-listener)
+ (buffer
+ start-time))
+
+ (luna-define-internal-accessors 'lunit-test-reporter))
+
+;; stolen (and renamed) from time-date.el.
+(defun lunit-time-since (time)
+ "Return the time elapsed since TIME."
+ (let* ((current (current-time))
+ (rest (when (< (nth 1 current) (nth 1 time))
+ (expt 2 16))))
+ (list (- (+ (car current) (if rest -1 0)) (car time))
+ (- (+ (or rest 0) (nth 1 current)) (nth 1 time))
+ (- (nth 2 current) (nth 2 time)))))
+
+(defun lunit-escape-quote (string)
+ (let ((index 0))
+ (while (string-match "\"" string index)
+ (setq string (replace-match """ nil t string)
+ index (+ 5 index)))
+ string))
+
+(luna-define-method lunit-test-listener-error ((reporter lunit-test-reporter)
+ case error)
+ (save-excursion
+ (set-buffer (lunit-test-reporter-buffer-internal reporter))
+ (insert (format "\
+ <error message=\"%s\" type=\"error\"/>
+"
+ (lunit-escape-quote (pp-to-string error))))))
+
+(luna-define-method lunit-test-listener-failure ((reporter lunit-test-reporter)
+ case failure)
+ (save-excursion
+ (set-buffer (lunit-test-reporter-buffer-internal reporter))
+ (insert (format "\
+ <failure message=\"%s\" type=\"failure\"/>
+"
+ (lunit-escape-quote (pp-to-string failure))))))
+
+(luna-define-method lunit-test-listener-start ((reporter lunit-test-reporter)
+ case)
+ (save-excursion
+ (set-buffer (lunit-test-reporter-buffer-internal reporter))
+ (goto-char (point-max))
+ (narrow-to-region (point) (point))
+ (insert (format "\
+ <testcase name=\"%s\" classname=\"%s\">
+"
+ (lunit-test-name-internal case)
+ (luna-class-name case)))
+ (lunit-test-reporter-set-start-time-internal reporter (current-time))))
+
+(luna-define-method lunit-test-listener-end ((reporter lunit-test-reporter)
+ case)
+ (let ((elapsed
+ (lunit-time-since
+ (lunit-test-reporter-start-time-internal reporter))))
+ (save-excursion
+ (set-buffer (lunit-test-reporter-buffer-internal reporter))
+
+ (insert "\
+ </testcase>
+")
+ (goto-char (point-min))
+ (looking-at " *<testcase\\>")
+ (goto-char (match-end 0))
+ (insert (format " time=\"%.03f\" "
+ (+ (nth 1 elapsed)
+ (/ (nth 2 elapsed) 1000000.0))))
+ (widen))))
+
+(defun lunit-report (test file)
+ "Run TEST and output result as XML."
+ (let* ((printer
+ (luna-make-entity 'lunit-test-printer))
+ (result
+ (lunit-make-test-result printer))
+ (buffer (find-file-noselect file))
+ start-time)
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer))
+ (lunit-test-result-add-listener
+ result
+ (luna-make-entity 'lunit-test-reporter :buffer buffer))
+ (setq start-time (current-time))
+ (lunit-test-run test result)
+ (let ((assert-count
+ (lunit-test-result-assert-count-internal result))
+ (failures
+ (lunit-test-result-failures-internal result))
+ (errors
+ (lunit-test-result-errors-internal result))
+
+ (elapsed (lunit-time-since start-time)))
+ (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
+ (lunit-test-number-of-tests test)
+ assert-count
+ (length failures)
+ (length errors)))
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (insert (format "\
+<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<testsuites>
+ <testsuite name=\"\" tests=\"%d\" failures=\"%d\" \
+errors=\"%d\" time =\"%.03f\">
+ <properties>
+ <property name=\"emacs-version\" value=\"%s\"/>
+ </properties>
+"
+ (lunit-test-number-of-tests test)
+ (length failures)
+ (length errors)
+ (+ (nth 1 elapsed)
+ (/ (nth 2 elapsed) 1000000.0))
+ (lunit-escape-quote (emacs-version))))
+ (goto-char (point-max))
+ (insert "\
+ </testsuite>
+</testsuites>")
+ (save-buffer)))))
+
+(provide 'lunit-report)
\ No newline at end of file
projects / elisp / riece.git / blobdiff