From: ueno <ueno>
Date: Sun, 28 Nov 2004 04:42:19 +0000 (+0000)
Subject: * COMPILE (riece-test): Use lunit-report instead of lunit.
X-Git-Tag: riece-1_0_6~15
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6ddec04f6082a06e033d0b395fae62d2dadda056;p=elisp%2Friece.git

* COMPILE (riece-test): Use lunit-report instead of lunit.

* test/lunit.el: Report test result as XML.
(lunit-time-since): New function.
(lunit-test-reporter): New test-listener.
(lunit-test-reporter-format-sexp): New function.
(lunit-report): New function.
---

diff --git a/lisp/COMPILE b/lisp/COMPILE
index 0c45e4a..a125e9b 100644
--- a/lisp/COMPILE
+++ b/lisp/COMPILE
@@ -144,6 +144,7 @@
     (require 'lunit)
     (setq suite (lunit-make-test-suite))
     (while files
+
       (when (file-regular-p (car files))
 	(load-file (car files))
 	(lunit-test-suite-add-test
@@ -152,4 +153,4 @@
 	  (intern (file-name-sans-extension
 		   (file-name-nondirectory (car files)))))))
       (setq files (cdr files)))
-    (lunit suite)))
\ No newline at end of file
+    (lunit-report suite)))
\ No newline at end of file
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 636fa6c..5db11c4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2004-11-28  Daiki Ueno  <ueno@unixuser.org>
+
+	* COMPILE (riece-test): Use lunit-report instead of lunit.
+
+	* test/lunit.el: Report test result as XML.
+	(lunit-time-since): New function.
+	(lunit-test-reporter): New test-listener.
+	(lunit-test-reporter-format-sexp): New function.
+	(lunit-report): New function.
+
 2004-11-27  Daiki Ueno  <ueno@unixuser.org>
 
 	* test/lunit.el: Update copyright year.
diff --git a/lisp/test/lunit.el b/lisp/test/lunit.el
index d166740..4fcf7aa 100644
--- a/lisp/test/lunit.el
+++ b/lisp/test/lunit.el
@@ -290,6 +290,134 @@ signal an error if not."
 		     (length failures)
 		     (length errors))))))
 
+;; 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)))))
+
+(eval-and-compile
+  (luna-define-class lunit-test-reporter (lunit-test-listener)
+		     (buffer
+		      start-time))
+
+  (luna-define-internal-accessors 'lunit-test-reporter))
+
+(defun lunit-test-reporter-format-sexp (sexp)
+  (with-temp-buffer
+    (insert (pp-to-string sexp))
+    (goto-char (point-min))
+    (while (re-search-forward "\\\\" nil t)
+      (replace-match "\\\\" nil t))
+    (goto-char (point-min))
+    (while (re-search-forward "\"" nil t)
+      (replace-match "&quot;" nil t))
+    (buffer-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-test-reporter-format-sexp 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-test-reporter-format-sexp 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)
+  "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 "lunit-report.xml"))
+	 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=\"lunit-test-suite\" tests=\"%d\" failures=\"%d\" \
+errors=\"%d\" time =\"%.03f\">
+"
+			(lunit-test-number-of-tests test)
+			(length failures)
+			(length errors)
+			(+ (nth 1 elapsed)
+			   (/ (nth 2 elapsed) 1000000.0))))
+	(goto-char (point-max))
+	(insert "\
+  </testsuite>
+</testsuites>")
+	(save-buffer)
+	))))
+
 (defvar imenu-create-index-function)
 (defun lunit-create-index-function ()
   (require 'imenu)