1 ;;; cus-test.el --- tests for custom types and load problems -*- lexical-binding: t; -*-
3 ;; Copyright (C) 1998, 2000, 2002-2024 Free Software Foundation, Inc.
5 ;; Author: Markus Rost <rost@math.uni-bielefeld.de>
6 ;; Created: 13 Sep 1998
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; This file provides simple tests to detect custom options with
27 ;; incorrect customization types and load problems for custom and
28 ;; autoload dependencies.
30 ;; The basic tests can be run in batch mode. Invoke them with
32 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts [all]
34 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps
36 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs [all]
38 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
40 ;; or as a part of the test suite with
42 ;; make -C test test-custom-opts
43 ;; make -C test test-custom-deps
44 ;; make -C test test-custom-libs
45 ;; make -C test test-custom-noloads
47 ;; in the emacs source directory.
49 ;; For interactive use: Load this file. Then
51 ;; M-x cus-test-apropos REGEXP RET
53 ;; checks the options matching REGEXP. In particular
55 ;; M-x cus-test-apropos RET
57 ;; checks all options. The detected options are stored in the
58 ;; variable `cus-test-errors'.
60 ;; Only those options are checked which have been already loaded.
61 ;; Therefore `cus-test-apropos' is more efficient after loading many
64 ;; M-x cus-test-load-custom-loads
66 ;; loads all (!) custom dependencies and
68 ;; M-x cus-test-load-libs
70 ;; loads all (!) libraries with autoloads.
72 ;; Options with a custom-get property, usually defined by a :get
73 ;; declaration, are stored in the variable
75 ;; `cus-test-vars-with-custom-get'
77 ;; Options with a state of 'changed ("changed outside the customize
78 ;; buffer") are stored in the variable
80 ;; `cus-test-vars-with-changed-state'
82 ;; These lists are prepared just in case one wants to investigate
83 ;; those options further.
85 ;; The command `cus-test-opts' tests many (all?) custom options.
87 ;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
88 ;; but reports about load errors.
90 ;; The command `cus-test-libs' runs for all libraries with autoloads
91 ;; separate emacs processes of the form "emacs -batch -l LIB".
93 ;; The command `cus-test-noloads' returns a list of variables which
94 ;; are somewhere declared as custom options, but not loaded by
95 ;; `custom-load-symbol'.
100 ;;; Workarounds. For a smooth run and to avoid some side effects.
102 (defvar cus-test-after-load-libs-hook nil
103 "Used to switch off undesired side effects of loading libraries.")
105 (defvar cus-test-skip-list nil
106 "List of variables to disregard by `cus-test-apropos'.")
108 (defvar cus-test-libs-noloads
109 ;; Loading dunnet in batch mode leads to a Dead end.
110 ;; blessmail writes a file.
111 ;; characters cannot be loaded twice ("Category `a' is already defined").
112 '("play/dunnet.el" "emulation/edt-mapper.el"
113 "loadup.el" "mail/blessmail.el" "international/characters.el"
114 "cedet/ede/loaddefs.el" "cedet/semantic/loaddefs.el"
115 "net/tramp-loaddefs.el")
116 "List of files not to load by `cus-test-load-libs'.
117 Names should be as they appear in loaddefs.el.")
119 ;; This avoids a hang of `cus-test-apropos' in 21.2.
120 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
125 (setq viper-mode nil
))
127 ;; Don't create a file `save-place-file'.
128 (eval-after-load "saveplace"
129 '(remove-hook 'kill-emacs-hook
'save-place-kill-emacs-hook
))
131 ;; Don't create a file `abbrev-file-name'.
132 (setq save-abbrevs nil
)
134 ;; Avoid compile logs from advised functions.
135 (eval-after-load "bytecomp"
136 '(setq ad-default-compilation-action
'never
))
141 ;; We want to log all messages.
142 (setq message-log-max t
)
147 (defvar cus-test-errors nil
148 "List of problematic variables found by `cus-test-apropos'.
149 Each element is (VARIABLE . PROBLEM); see `cus-test--format-error'.")
151 (defvar cus-test-tested-variables nil
152 "List of options tested by last call of `cus-test-apropos'.")
154 ;; I haven't understood this :get stuff. The symbols with a
155 ;; custom-get property are stored here.
156 (defvar cus-test-vars-with-custom-get nil
157 "Set by `cus-test-apropos' to a list of options with :get property.")
159 (defvar cus-test-vars-with-changed-state nil
160 "Set by `cus-test-apropos' to a list of options with state \\='changed.")
162 (defvar cus-test-deps-errors nil
163 "List of require/load problems found by `cus-test-deps'.")
165 (defvar cus-test-deps-required nil
166 "List of dependencies required by `cus-test-deps'.
167 Only unloaded features will be require'd.")
169 (defvar cus-test-deps-loaded nil
170 "List of dependencies loaded by `cus-test-deps'.")
172 (defvar cus-test-libs-errors nil
173 "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
175 (defvar cus-test-libs-loaded nil
176 "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
178 (defvar cus-test-vars-not-cus-loaded nil
179 "A list of options not loaded by `custom-load-symbol'.
180 Set by `cus-test-noloads'.")
182 ;; (defvar cus-test-vars-cus-loaded nil
183 ;; "A list of options loaded by `custom-load-symbol'.")
185 (defun cus-test--format-error (err)
186 "Format an element of `cus-test-errors'."
188 (`(,var
:type-error
,value
,type
)
189 (format "variable: %s\n value: %S\n type: %S" var value type
))
190 (`(,var
:other-error
,e
)
191 (format "variable: %s\n error: %S" var e
))
192 (_ (format "%S" err
))))
194 (defun cus-test-apropos (regexp)
195 "Check the options matching REGEXP.
196 The detected problematic options are stored in `cus-test-errors'."
197 (interactive "sVariable regexp: ")
198 (setq cus-test-errors nil
)
199 (setq cus-test-tested-variables nil
)
202 (push symbol cus-test-tested-variables
)
203 ;; Be verbose in case we hang.
204 (message "Cus Test running...%s %s"
205 (length cus-test-tested-variables
) symbol
)
206 (condition-case alpha
207 ;; FIXME This defaults to 'sexp if no type was specified.
208 ;; Always report such instances as a type mismatch.
209 ;; Currently abusing cusver-scan to do that.
210 (let* ((type (custom-variable-type symbol
))
211 (conv (widget-convert type
))
212 (get (or (get symbol
'custom-get
) 'default-value
))
214 (when (default-boundp symbol
)
215 (push (funcall get symbol
) values
)
216 (push (eval (car (get symbol
'standard-value
)) t
) values
))
218 (push (symbol-value symbol
) values
))
219 ;; That does not work.
220 ;; (push (widget-get conv :value) values)
223 (mapc (lambda (value)
224 (unless (widget-apply conv
:match value
)
225 (let ((err (list symbol
:type-error value type
)))
226 (unless (member err cus-test-errors
)
227 (push err cus-test-errors
)))))
230 ;; Store symbols with a custom-get property.
231 (when (get symbol
'custom-get
)
232 (add-to-list 'cus-test-vars-with-custom-get symbol
))
234 ;; Changed outside the customize buffer?
235 ;; This routine is not very much tested.
237 (or (get symbol
'customized-value
)
238 (get symbol
'saved-value
)
239 (get symbol
'standard-value
))))
242 (not (equal (eval (car c-value
) t
) (symbol-value symbol
)))
243 (add-to-list 'cus-test-vars-with-changed-state symbol
))))
246 (let ((err (list symbol
:other-error alpha
)))
247 (unless (member err cus-test-errors
)
248 (push err cus-test-errors
)))
249 (message "Error for %s: %s" symbol alpha
))))
250 (cus-test-get-options regexp
))
251 (message "%s options tested"
252 (length cus-test-tested-variables
))
253 (cus-test-errors-display))
255 (defun cus-test-cus-load-groups (&optional cus-load
)
256 "Return a list of current custom groups.
257 If CUS-LOAD is non-nil, include groups from cus-load.el."
258 (append (mapcar #'cdr custom-current-group-alist
)
261 (insert-file-contents (locate-library "cus-load.el"))
262 (search-forward "(put '")
265 (while (and (looking-at "^(put '\\(\\S-+\\)")
266 (zerop (forward-line 1)))
267 (push (intern (match-string 1)) res
))
270 (defun cus-test-get-options (regexp &optional group
)
271 "Return a list of custom options matching REGEXP.
272 If GROUP is non-nil, return groups rather than options.
273 If GROUP is `cus-load', include groups listed in cus-loads as well as
274 currently defined groups."
275 (let ((groups (if group
(cus-test-cus-load-groups (eq group
'cus-load
))))
283 ;; (custom-variable-p symbol)
284 (get symbol
'standard-value
)
285 ;; (get symbol 'saved-value)
286 (get symbol
'custom-type
)))
287 (string-match regexp
(symbol-name symbol
))
288 (not (member symbol cus-test-skip-list
))
289 (push symbol found
))))
292 (defun cus-test-errors-display ()
293 "Report about the errors found by cus-test."
294 (with-output-to-temp-buffer "*cus-test-errors*"
295 (set-buffer standard-output
)
296 (insert (format "Cus Test tested %s variables.\
297 See `cus-test-tested-variables'.\n\n"
298 (length cus-test-tested-variables
)))
299 (if (not cus-test-errors
)
300 (insert "No errors found by cus-test.")
301 (insert "The following variables seem to have problems:\n\n")
302 (dolist (e cus-test-errors
)
303 (insert (cus-test--format-error e
) "\n")))))
305 (defun cus-test-load-custom-loads ()
306 "Call `custom-load-symbol' on all atoms."
308 (if noninteractive
(let (noninteractive) (require 'dunnet
)))
309 (mapatoms #'custom-load-symbol
)
310 (run-hooks 'cus-test-after-load-libs-hook
))
312 (defmacro cus-test-load-1
(&rest body
)
314 (setq cus-test-libs-errors nil
315 cus-test-libs-loaded nil
)
317 (message "%s libraries loaded successfully"
318 (length cus-test-libs-loaded
))
319 (if (not cus-test-libs-errors
)
320 (message "No load problems encountered")
321 (message "The following load problems appeared:")
322 (cus-test-message cus-test-libs-errors
))
323 (run-hooks 'cus-test-after-load-libs-hook
)))
325 ;; This is just cus-test-libs, but loading in the current Emacs process.
326 (defun cus-test-load-libs (&optional more
)
327 "Load the libraries with autoloads.
328 Don't load libraries in `cus-test-libs-noloads'.
329 If optional argument MORE is \"defcustom\", load all files with defcustoms.
330 If it is \"all\", load all Lisp files."
333 (let ((lispdir (file-name-directory (locate-library "loaddefs"))))
336 (condition-case alpha
337 (unless (member file cus-test-libs-noloads
)
338 (load (file-name-sans-extension (expand-file-name file lispdir
))
340 (push file cus-test-libs-loaded
))
342 (push (cons file alpha
) cus-test-libs-errors
)
343 (message "Error for %s: %s" file alpha
))))
345 (cus-test-get-lisp-files (equal more
"all"))
346 (cus-test-get-autoload-deps))))))
348 (defun cus-test-get-autoload-deps ()
349 "Return the list of files with autoloads."
351 (insert-file-contents (locate-library "loaddefs"))
353 (while (search-forward "\n;;; Generated autoloads from " nil t
)
354 (push (buffer-substring (match-end 0) (line-end-position)) files
))
357 (defun cus-test-get-lisp-files (&optional all
)
358 "Return list of all Lisp files with defcustoms.
359 Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
360 (let ((default-directory (expand-file-name "lisp/" source-directory
))
361 (msg "Finding files..."))
364 ;; Hack to remove leading "./".
365 (mapcar (lambda (e) (substring e
2))
366 (apply #'process-lines find-program
367 "." "-name" "obsolete" "-prune" "-o"
368 "-name" "ldefs-boot.el" "-prune" "-o"
369 "-name" "*loaddefs.el" "-prune" "-o"
370 "-name" "[^.]*.el" ; ignore .dir-locals.el
373 (list "-exec" grep-program
374 "-l" "^[ \t]*(defcustom" "{}" "+"))))
375 (message "%sdone" msg
))))
377 (defun cus-test-message (list)
378 "Print the members of LIST line by line."
379 (dolist (m list
) (message "%s" m
)))
382 ;;; The routines for batch mode:
384 (defun cus-test-opts (&optional all
)
385 "Test custom options.
386 This function is suitable for batch mode. E.g., invoke
388 src/emacs -batch -l admin/cus-test.el -f cus-test-opts
390 in the Emacs source directory.
391 Normally only tests options belonging to files in loaddefs.el.
392 If optional argument ALL is non-nil, test all files with defcustoms.
394 Returns a list of variables with suspicious types."
397 command-line-args-left
398 (setq all
(pop command-line-args-left
)))
399 (message "Running %s" 'cus-test-load-libs
)
400 (cus-test-load-libs (if all
"defcustom"))
401 (message "Running %s" 'cus-test-load-custom-loads
)
402 (cus-test-load-custom-loads)
403 (message "Running %s" 'cus-test-apropos
)
404 (cus-test-apropos "")
405 (if (not cus-test-errors
)
407 (message "No problems found")
409 (message "The following options might have problems:")
410 (cus-test-message (mapcar #'cus-test--format-error cus-test-errors
))
413 (defun cus-test-deps ()
414 "Run a verbose version of `custom-load-symbol' on all atoms.
415 This function is suitable for batch mode. E.g., invoke
417 src/emacs -batch -l admin/cus-test.el -f cus-test-deps
419 in the Emacs source directory."
421 (setq cus-test-deps-errors nil
)
422 (setq cus-test-deps-required nil
)
423 (setq cus-test-deps-loaded nil
)
425 ;; This code is mainly from `custom-load-symbol'.
427 (let ((custom-load-recursion t
)
431 "quail" (file-name-directory (locate-library leim-list-file-name
)))
433 (dolist (load (get symbol
'custom-loads
))
436 ;; (condition-case nil (require load) (error nil))
437 (condition-case alpha
438 (unless (or (featurep load
)
439 (and noninteractive
(eq load
'dunnet
)))
441 (push (list symbol load
) cus-test-deps-required
))
443 (push (list symbol load alpha
) cus-test-deps-errors
)
444 (message "Require problem: %s %s %s" symbol load alpha
))))
445 ((equal load
"loaddefs")
447 (message "Symbol %s has loaddefs as custom dependency" symbol
)
448 cus-test-deps-errors
))
449 ;; This is subsumed by the test below, but it's much
451 ((assoc load load-history
))
453 ;; (assoc (locate-library load) load-history)
454 ;; but has been optimized not to load locate-library
456 ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load
)
459 (dolist (loaded load-history
)
460 (and (stringp (car loaded
))
461 (string-match regexp
(car loaded
))
464 ;; Without this, we would load cus-edit recursively.
465 ;; We are still loading it when we call this,
466 ;; and it is not in load-history yet.
467 ((equal load
"cus-edit"))
468 ;; This would ignore load problems with files in
470 ;; ((locate-library (concat term-file-prefix load)))
472 ;; (condition-case nil (load load) (error nil))
473 (condition-case alpha
476 (push (list symbol load
) cus-test-deps-loaded
))
478 (push (list symbol load alpha
) cus-test-deps-errors
)
479 (message "Load Problem: %s %s %s" symbol load alpha
))))
481 (message "%s features required"
482 (length cus-test-deps-required
))
483 (message "%s files loaded"
484 (length cus-test-deps-loaded
))
485 (if (not cus-test-deps-errors
)
486 (message "No load problems encountered")
487 (message "The following load problems appeared:")
488 (cus-test-message cus-test-deps-errors
))
489 (run-hooks 'cus-test-after-load-libs-hook
))
491 (defun cus-test-libs (&optional more
)
492 "Load the libraries with autoloads in separate processes.
493 This function is useful to detect load problems of libraries.
494 It is suitable for batch mode. E.g., invoke
496 ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs
498 in the Emacs source directory.
500 If optional argument MORE is \"defcustom\", load all files with defcustoms.
501 If it is \"all\", load all Lisp files."
504 command-line-args-left
505 (setq more
(pop command-line-args-left
)))
507 (let* ((default-directory source-directory
)
508 (emacs (expand-file-name "src/emacs"))
510 (or (file-executable-p emacs
)
511 (error "No such executable `%s'" emacs
))
514 (if (member file cus-test-libs-noloads
)
516 (condition-case alpha
517 (let* ((fn (expand-file-name file
"lisp/"))
518 (elc (concat fn
"c"))
520 (if (file-readable-p elc
) ; load compiled if present (faster)
522 (or (file-readable-p fn
)
523 (error "Library %s not found" file
)))
524 (if (equal 0 (setq status
(call-process emacs nil nil nil
528 (push file cus-test-libs-loaded
))
530 (push (cons file alpha
) cus-test-libs-errors
)
531 (message "Error for %s: %s" file alpha
)))))
533 (cus-test-get-lisp-files (equal more
"all"))
534 (cus-test-get-autoload-deps)))
535 (message "Default directory: %s" default-directory
)
537 (message "The following libraries were skipped:")
538 (cus-test-message skipped
)))))
540 (defun cus-test-noloads ()
541 "Find custom options not loaded by `custom-load-symbol'.
542 Calling this function after `cus-test-load-libs' is not meaningful.
543 It is suitable for batch mode. E.g., invoke
545 src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
547 in the Emacs source directory."
549 (let ((groups-loaded (cus-test-get-options "" 'cus-load
))
550 cus-loaded groups-not-loaded
)
552 (message "Running %s" 'cus-test-load-custom-loads
)
553 (cus-test-load-custom-loads)
554 (setq cus-loaded
(cus-test-get-options ""))
556 (message "Running %s" 'cus-test-load-libs
)
557 (cus-test-load-libs "all")
558 (setq cus-test-vars-not-cus-loaded
(cus-test-get-options "")
559 groups-not-loaded
(cus-test-get-options "" t
))
561 (dolist (o cus-loaded
)
562 (setq cus-test-vars-not-cus-loaded
563 (delete o cus-test-vars-not-cus-loaded
)))
565 (if (not cus-test-vars-not-cus-loaded
)
566 (message "No options not loaded by custom-load-symbol found")
567 (message "The following options were not loaded by custom-load-symbol:")
569 (sort cus-test-vars-not-cus-loaded
#'string
<)))
571 (dolist (o groups-loaded
)
572 (setq groups-not-loaded
(delete o groups-not-loaded
)))
574 (if (not groups-not-loaded
)
575 (message "No groups not in cus-load.el found")
576 (message "The following groups are not in cus-load.el:")
577 (cus-test-message (sort groups-not-loaded
#'string
<)))))
581 ;;; cus-test.el ends here