;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile (require 'cl))
+(require 'pp)
+
;;; @ test
;;;
(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 """ 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)
")))))))
-(defun batch-lunit ()
- (let ((load-path (cons (expand-file-name (car command-line-args-left))
- (cons nil load-path)))
- (files (directory-files (expand-file-name (car command-line-args-left))
- t "^test-.*\\.el$"))
- suite)
- (setq suite (lunit-make-test-suite))
- (while files
- (when (file-regular-p (car files))
- (load-file (car files))
- (lunit-test-suite-add-test
- suite
- (lunit-make-test-suite-from-class
- (intern (file-name-sans-extension
- (file-name-nondirectory (car files)))))))
- (setq files (cdr files)))
- (lunit suite)))
-
(provide 'lunit)
;;; lunit.el ends here
projects / riece / blobdiff