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.
This commit is contained in:
parent
bdbb709978
commit
465a9e78b9
1 changed files with 21 additions and 11 deletions
|
@ -145,7 +145,8 @@ Names should be as they appear in loaddefs.el.")
|
||||||
(require 'cus-load)
|
(require 'cus-load)
|
||||||
|
|
||||||
(defvar cus-test-errors nil
|
(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
|
(defvar cus-test-tested-variables nil
|
||||||
"List of options tested by last call of `cus-test-apropos'.")
|
"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
|
;; (defvar cus-test-vars-cus-loaded nil
|
||||||
;; "A list of options loaded by `custom-load-symbol'.")
|
;; "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)
|
(defun cus-test-apropos (regexp)
|
||||||
"Check the options matching REGEXP.
|
"Check the options matching REGEXP.
|
||||||
The detected problematic options are stored in `cus-test-errors'."
|
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))
|
(let* ((type (custom-variable-type symbol))
|
||||||
(conv (widget-convert type))
|
(conv (widget-convert type))
|
||||||
(get (or (get symbol 'custom-get) 'default-value))
|
(get (or (get symbol 'custom-get) 'default-value))
|
||||||
values
|
values)
|
||||||
mismatch)
|
|
||||||
(when (default-boundp symbol)
|
(when (default-boundp symbol)
|
||||||
(push (funcall get symbol) values)
|
(push (funcall get symbol) values)
|
||||||
(push (eval (car (get symbol 'standard-value)) t) 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
|
;; TODO for booleans, check for values that can be
|
||||||
;; evaluated and are not t or nil. Usually a bug.
|
;; evaluated and are not t or nil. Usually a bug.
|
||||||
(unless (widget-apply conv :match value)
|
(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)
|
values)
|
||||||
|
|
||||||
;; Store symbols with a custom-get property.
|
;; 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)
|
(and (consp c-value)
|
||||||
(boundp symbol)
|
(boundp symbol)
|
||||||
(not (equal (eval (car c-value) t) (symbol-value symbol)))
|
(not (equal (eval (car c-value) t) (symbol-value symbol)))
|
||||||
(add-to-list 'cus-test-vars-with-changed-state symbol)))
|
(add-to-list 'cus-test-vars-with-changed-state symbol))))
|
||||||
|
|
||||||
(if mismatch
|
|
||||||
(push symbol cus-test-errors)))
|
|
||||||
|
|
||||||
(error
|
(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))))
|
(message "Error for %s: %s" symbol alpha))))
|
||||||
(cus-test-get-options regexp))
|
(cus-test-get-options regexp))
|
||||||
(message "%s options tested"
|
(message "%s options tested"
|
||||||
|
@ -292,7 +302,7 @@ currently defined groups."
|
||||||
(insert "No errors found by cus-test.")
|
(insert "No errors found by cus-test.")
|
||||||
(insert "The following variables seem to have problems:\n\n")
|
(insert "The following variables seem to have problems:\n\n")
|
||||||
(dolist (e cus-test-errors)
|
(dolist (e cus-test-errors)
|
||||||
(insert (symbol-name e) "\n")))))
|
(insert (cus-test--format-error e) "\n")))))
|
||||||
|
|
||||||
(defun cus-test-load-custom-loads ()
|
(defun cus-test-load-custom-loads ()
|
||||||
"Call `custom-load-symbol' on all atoms."
|
"Call `custom-load-symbol' on all atoms."
|
||||||
|
@ -399,7 +409,7 @@ Returns a list of variables with suspicious types."
|
||||||
(message "No problems found")
|
(message "No problems found")
|
||||||
nil)
|
nil)
|
||||||
(message "The following options might have problems:")
|
(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))
|
cus-test-errors))
|
||||||
|
|
||||||
(defun cus-test-deps ()
|
(defun cus-test-deps ()
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue