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