summaryrefslogtreecommitdiff
path: root/admin
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2022-12-09 12:04:01 +0100
committerMattias EngdegÄrd <mattiase@acm.org>2022-12-09 12:07:01 +0100
commit465a9e78b9661edd1b77a8c1d8e262913724ab71 (patch)
treecf9bec5192c443db79560d1da65941283588eaaf /admin
parentbdbb7099784eb79ef9b94bb85f0c3dc9dae82d6c (diff)
downloademacs-465a9e78b9661edd1b77a8c1d8e262913724ab71.tar.gz
Better test-custom-opts diagnostics
Make it easier to understand errors from the test-custom-opts test by reporting variable values and types that didn't match. * admin/cus-test.el (cus-test-errors): Richer contents. (cus-test--format-error): New. (cus-test-apropos, cus-test-errors-display, cus-test-opts): Use new format.
Diffstat (limited to 'admin')
-rw-r--r--admin/cus-test.el32
1 files changed, 21 insertions, 11 deletions
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 7e73f2e44aa..44897cd1060 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -145,7 +145,8 @@ Names should be as they appear in loaddefs.el.")
(require 'cus-load)
(defvar cus-test-errors nil
- "List of problematic variables found by `cus-test-apropos'.")
+ "List of problematic variables found by `cus-test-apropos'.
+Each element is (VARIABLE . PROBLEM); see `cus-test--format-problem'.")
(defvar cus-test-tested-variables nil
"List of options tested by last call of `cus-test-apropos'.")
@@ -181,6 +182,15 @@ Set by `cus-test-noloads'.")
;; (defvar cus-test-vars-cus-loaded nil
;; "A list of options loaded by `custom-load-symbol'.")
+(defun cus-test--format-error (err)
+ "Format an element of `cus-test-errors'."
+ (pcase err
+ (`(,var :type-error ,value ,type)
+ (format "variable: %s\n value: %S\n type: %S" var value type))
+ (`(,var :other-error ,e)
+ (format "variable: %s\n error: %S" var e))
+ (_ (format "%S" err))))
+
(defun cus-test-apropos (regexp)
"Check the options matching REGEXP.
The detected problematic options are stored in `cus-test-errors'."
@@ -200,8 +210,7 @@ The detected problematic options are stored in `cus-test-errors'."
(let* ((type (custom-variable-type symbol))
(conv (widget-convert type))
(get (or (get symbol 'custom-get) 'default-value))
- values
- mismatch)
+ values)
(when (default-boundp symbol)
(push (funcall get symbol) values)
(push (eval (car (get symbol 'standard-value)) t) values))
@@ -215,7 +224,9 @@ The detected problematic options are stored in `cus-test-errors'."
;; TODO for booleans, check for values that can be
;; evaluated and are not t or nil. Usually a bug.
(unless (widget-apply conv :match value)
- (setq mismatch 'mismatch)))
+ (let ((err (list symbol :type-error value type)))
+ (unless (member err cus-test-errors)
+ (push err cus-test-errors)))))
values)
;; Store symbols with a custom-get property.
@@ -231,13 +242,12 @@ The detected problematic options are stored in `cus-test-errors'."
(and (consp c-value)
(boundp symbol)
(not (equal (eval (car c-value) t) (symbol-value symbol)))
- (add-to-list 'cus-test-vars-with-changed-state symbol)))
-
- (if mismatch
- (push symbol cus-test-errors)))
+ (add-to-list 'cus-test-vars-with-changed-state symbol))))
(error
- (push symbol cus-test-errors)
+ (let ((err (list symbol :other-error alpha)))
+ (unless (member err cus-test-errors)
+ (push err cus-test-errors)))
(message "Error for %s: %s" symbol alpha))))
(cus-test-get-options regexp))
(message "%s options tested"
@@ -292,7 +302,7 @@ currently defined groups."
(insert "No errors found by cus-test.")
(insert "The following variables seem to have problems:\n\n")
(dolist (e cus-test-errors)
- (insert (symbol-name e) "\n")))))
+ (insert (cus-test--format-error e) "\n")))))
(defun cus-test-load-custom-loads ()
"Call `custom-load-symbol' on all atoms."
@@ -399,7 +409,7 @@ Returns a list of variables with suspicious types."
(message "No problems found")
nil)
(message "The following options might have problems:")
- (cus-test-message cus-test-errors)
+ (cus-test-message (mapcar #'cus-test--format-error cus-test-errors))
cus-test-errors))
(defun cus-test-deps ()