;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: Not in FSF
+;;; Synched up with: Not in FSF.
;;; Commentary:
;;; Basically you just create files of emacs-lisp, and use the
;;; Assert, Check-Error, and Check-Message functions to create tests.
;;; You run the tests using M-x test-emacs-test-file,
-;;; or $(EMACS) -l .../test-harness.el -f batch-test-emacs file ...
+;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
;;; which is run for you by the `make check' target in the top-level Makefile.
(require 'bytecomp)
(defvar test-harness-current-file nil)
-(defvar emacs-lisp-file-regexp (purecopy "\\.el$")
+(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
"*Regexp which matches Emacs Lisp source files.")
;;;###autoload
(setq body (cons (read buffer) body)))
(end-of-file nil)
(error
- (princ "Unexpected error %S reading forms from buffer\n" error-info)))
+ (princ (format "Unexpected error %S reading forms from buffer\n" error-info))))
`(lambda ()
(defvar passes)
(defvar assertion-failures)
(missing-message-failures 0)
(other-failures 0)
+ ;; #### perhaps this should be a defvar, and output at the very end
+ ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find
+ ;; what stuff is needed, and ways to avoid using them
+ (skipped-test-reasons (make-hash-table :test 'equal))
+
(trick-optimizer nil)
(unexpected-test-suite-failure nil)
(debug-on-error t))
,quoted-body ',expected-error error-info))
(incf wrong-error-failures)))))
+ (defun Print-Skip (test reason &optional fmt &rest args)
+ (setq fmt (concat "SKIP: %S. REASON: %S" fmt))
+ (princ (concat (apply #'format fmt test reason args) "\n")))
+
(defmacro Check-Message (expected-message-regexp &rest body)
- (let ((quoted-body (if (= 1 (length body))
- `(quote ,(car body)) `(quote (progn ,@body)))))
- `(let ((messages ""))
- (defadvice message (around collect activate)
- (defvar messages)
- (let ((msg-string (apply 'format (ad-get-args 0))))
- (setq messages (concat messages msg-string))
- msg-string))
- (condition-case error-info
- (progn
- (setq trick-optimizer (progn ,@body))
- (if (string-match ,expected-message-regexp messages)
- (progn
- (princ (format "PASS: %S ==> value %S, message %S, matching %S, as expected\n"
- ,quoted-body trick-optimizer messages ',expected-message-regexp))
- (incf passes))
- (princ (format "FAIL: %S ==> value %S, message %S, NOT matching expected %S\n"
- ,quoted-body trick-optimizer messages ',expected-message-regexp))
- (incf missing-message-failures)))
- (error
- (princ (format "FAIL: %S ==> unexpected error %S\n"
- ,quoted-body error-info))
- (incf other-failures)))
- (ad-unadvise 'message))))
+ (if (not (fboundp 'defadvice))
+ ;; #### This whole thing should go inside a macro Skip-Test
+ (let* ((reason "advice unavailable")
+ (count (gethash reason skipped-test-reasons)))
+ ;(message "%S: %S" reason count)
+ (puthash reason (if (null count) 1 (1+ count))
+ skipped-test-reasons)
+ `(Print-Skip ,expected-message-regexp ,reason))
+ (let ((quoted-body (if (= 1 (length body))
+ `(quote ,(car body)) `(quote (progn ,@body)))))
+ `(let ((messages ""))
+ (defadvice message (around collect activate)
+ (defvar messages)
+ (let ((msg-string (apply 'format (ad-get-args 0))))
+ (setq messages (concat messages msg-string))
+ msg-string))
+ (condition-case error-info
+ (progn
+ (setq trick-optimizer (progn ,@body))
+ (if (string-match ,expected-message-regexp messages)
+ (progn
+ (princ (format "PASS: %S ==> value %S, message %S, matching %S, as expected\n"
+ ,quoted-body trick-optimizer messages ',expected-message-regexp))
+ (incf passes))
+ (princ (format "FAIL: %S ==> value %S, message %S, NOT matching expected %S\n"
+ ,quoted-body trick-optimizer messages ',expected-message-regexp))
+ (incf missing-message-failures)))
+ (error
+ (princ (format "FAIL: %S ==> unexpected error %S\n"
+ ,quoted-body error-info))
+ (incf other-failures)))
+ (ad-unadvise 'message)))))
(defmacro Ignore-Ebola (&rest body)
`(let ((debug-issue-ebola-notices -42)) ,@body))
(princ "\nTesting Compiled Lisp\n\n")
(let (code)
(condition-case error-info
- (setq code (let ((byte-compile-warnings nil))
- (byte-compile (test-harness-read-from-buffer inbuffer))))
+ (setq code
+ ;; our lisp code is often intentionally dubious,
+ ;; so throw away _all_ the byte compiler warnings.
+ (letf (((symbol-function 'byte-compile-warn) 'ignore))
+ (byte-compile (test-harness-read-from-buffer inbuffer))))
(error
(princ (format "Unexpected error %S while byte-compiling code\n"
error-info))))
(if (> total 0)
(format "%s: %d of %d (%d%%) tests successful."
basename passes total (/ (* 100 passes) total))
- (format "%s: No tests run" basename))))
+ (format "%s: No tests run" basename)))
+ (reasons ""))
+ (maphash (lambda (key value)
+ (setq reasons
+ (concat reasons
+ (format "\n %d tests skipped because %s"
+ value key))))
+ skipped-test-reasons)
+ (when (> (length reasons) 1)
+ (setq summary-msg (concat summary-msg reasons "
+ Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH
+ to the package hierarchy root or configure with --package-path to enable
+ the skipped tests.")))
(message "%s" summary-msg))
(when unexpected-test-suite-failure
(message "Test suite execution failed unexpectedly."))
(fmakunbound 'Assert)
(fmakunbound 'Check-Error)
+ (fmakunbound 'Check-Message)
+ (fmakunbound 'Check-Error-Message)
(fmakunbound 'Ignore-Ebola)
(fmakunbound 'Int-to-Marker)
)))
(if (not noninteractive)
(error "`batch-test-emacs' is to be used only with -batch"))
(let ((error nil))
- (loop for file in command-line-args-left
- do
- (if (file-directory-p (expand-file-name file))
- (let ((files (directory-files file))
- source)
- (while files
- (if (and (string-match emacs-lisp-file-regexp (car files))
- (not (auto-save-file-name-p (car files)))
- (setq source (expand-file-name
- (car files)
- file))
- (if (null (batch-test-emacs-1 source))
- (setq error t)))
- (setq files (cdr files)))))
- (if (null (batch-test-emacs-1 file))
+ (dolist (file command-line-args-left)
+ (if (file-directory-p file)
+ (dolist (file-in-dir (directory-files file t))
+ (when (and (string-match emacs-lisp-file-regexp file-in-dir)
+ (not (or (auto-save-file-name-p file-in-dir)
+ (backup-file-name-p file-in-dir)
+ (equal (file-name-nondirectory file-in-dir)
+ "test-harness.el"))))
+ (or (batch-test-emacs-1 file-in-dir)
+ (setq error t))))
+ (or (batch-test-emacs-1 file)
(setq error t))))
;;(message "%s" (buffer-string nil nil "*Test-Log*"))
(message "Done")
projects / chise / xemacs-chise.git.1 / blobdiff