(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)
)))