Use cookie functions in yow
[emacs.git] / admin / cus-test.el
blob6b8ec9abe020cd69a5f3c53fcef94778b1bc32ca
1 ;;; cus-test.el --- tests for custom types and load problems
3 ;; Copyright (C) 1998, 2000, 2002-2013 Free Software Foundation, Inc.
5 ;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
6 ;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
7 ;; Created: 13 Sep 1998
8 ;; Keywords: maint
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; This file provides simple tests to detect custom options with
28 ;; incorrect customization types and load problems for custom and
29 ;; autoload dependencies.
31 ;; The basic tests can be run in batch mode. Invoke them with
33 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts [all]
35 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps
37 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs [all]
39 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
41 ;; in the emacs source directory.
43 ;; For interactive use: Load this file. Then
45 ;; M-x cus-test-apropos REGEXP RET
47 ;; checks the options matching REGEXP. In particular
49 ;; M-x cus-test-apropos RET
51 ;; checks all options. The detected options are stored in the
52 ;; variable `cus-test-errors'.
54 ;; Only those options are checked which have been already loaded.
55 ;; Therefore `cus-test-apropos' is more efficient after loading many
56 ;; libraries.
58 ;; M-x cus-test-load-custom-loads
60 ;; loads all (!) custom dependencies and
62 ;; M-x cus-test-load-libs
64 ;; loads all (!) libraries with autoloads.
66 ;; Options with a custom-get property, usually defined by a :get
67 ;; declaration, are stored in the variable
69 ;; `cus-test-vars-with-custom-get'
71 ;; Options with a state of 'changed ("changed outside the customize
72 ;; buffer") are stored in the variable
74 ;; `cus-test-vars-with-changed-state'
76 ;; These lists are prepared just in case one wants to investigate
77 ;; those options further.
79 ;; The command `cus-test-opts' tests many (all?) custom options.
81 ;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
82 ;; but reports about load errors.
84 ;; The command `cus-test-libs' runs for all libraries with autoloads
85 ;; separate emacs processes of the form "emacs -batch -l LIB".
87 ;; The command `cus-test-noloads' returns a list of variables which
88 ;; are somewhere declared as custom options, but not loaded by
89 ;; `custom-load-symbol'.
92 ;;; Code:
94 ;;; Workarounds. For a smooth run and to avoid some side effects.
96 (defvar cus-test-after-load-libs-hook nil
97 "Used to switch off undesired side effects of loading libraries.")
99 (defvar cus-test-skip-list nil
100 "List of variables to disregard by `cus-test-apropos'.")
102 (defvar cus-test-libs-noloads
103 ;; Loading dunnet in batch mode leads to a Dead end.
104 ;; blessmail writes a file.
105 ;; characters cannot be loaded twice ("Category `a' is already defined").
106 '("play/dunnet.el" "emulation/edt-mapper.el"
107 "loadup.el" "mail/blessmail.el" "international/characters.el"
108 "cedet/ede/loaddefs.el" "cedet/semantic/loaddefs.el"
109 "net/tramp-loaddefs.el")
110 "List of files not to load by `cus-test-load-libs'.
111 Names should be as they appear in loaddefs.el.")
113 ;; This avoids a hang of `cus-test-apropos' in 21.2.
114 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
116 (or noninteractive
117 ;; Never Viperize.
118 (setq viper-mode nil))
120 ;; Don't create a file `save-place-file'.
121 (eval-after-load "saveplace"
122 '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
124 ;; Don't create a file `abbrev-file-name'.
125 (setq save-abbrevs nil)
127 ;; Avoid compile logs from adviced functions.
128 (eval-after-load "bytecomp"
129 '(setq ad-default-compilation-action 'never))
132 ;;; Main code:
134 ;; We want to log all messages.
135 (setq message-log-max t)
137 (require 'cus-edit)
138 (require 'cus-load)
140 (defvar cus-test-errors nil
141 "List of problematic variables found by `cus-test-apropos'.")
143 (defvar cus-test-tested-variables nil
144 "List of options tested by last call of `cus-test-apropos'.")
146 ;; I haven't understood this :get stuff. The symbols with a
147 ;; custom-get property are stored here.
148 (defvar cus-test-vars-with-custom-get nil
149 "Set by `cus-test-apropos' to a list of options with :get property.")
151 (defvar cus-test-vars-with-changed-state nil
152 "Set by `cus-test-apropos' to a list of options with state 'changed.")
154 (defvar cus-test-deps-errors nil
155 "List of require/load problems found by `cus-test-deps'.")
157 (defvar cus-test-deps-required nil
158 "List of dependencies required by `cus-test-deps'.
159 Only unloaded features will be require'd.")
161 (defvar cus-test-deps-loaded nil
162 "List of dependencies loaded by `cus-test-deps'.")
164 (defvar cus-test-libs-errors nil
165 "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
167 (defvar cus-test-libs-loaded nil
168 "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
170 (defvar cus-test-vars-not-cus-loaded nil
171 "A list of options not loaded by `custom-load-symbol'.
172 Set by `cus-test-noloads'.")
174 ;; (defvar cus-test-vars-cus-loaded nil
175 ;; "A list of options loaded by `custom-load-symbol'.")
177 (defun cus-test-apropos (regexp)
178 "Check the options matching REGEXP.
179 The detected problematic options are stored in `cus-test-errors'."
180 (interactive "sVariable regexp: ")
181 (setq cus-test-errors nil)
182 (setq cus-test-tested-variables nil)
183 (mapc
184 (lambda (symbol)
185 (push symbol cus-test-tested-variables)
186 ;; Be verbose in case we hang.
187 (message "Cus Test running...%s %s"
188 (length cus-test-tested-variables) symbol)
189 (condition-case alpha
190 (let* ((type (custom-variable-type symbol))
191 (conv (widget-convert type))
192 (get (or (get symbol 'custom-get) 'default-value))
193 values
194 mismatch)
195 (when (default-boundp symbol)
196 (push (funcall get symbol) values)
197 (push (eval (car (get symbol 'standard-value))) values))
198 (if (boundp symbol)
199 (push (symbol-value symbol) values))
200 ;; That does not work.
201 ;; (push (widget-get conv :value) values)
203 ;; Check the values
204 (mapc (lambda (value)
205 (unless (widget-apply conv :match value)
206 (setq mismatch 'mismatch)))
207 values)
209 ;; Store symbols with a custom-get property.
210 (when (get symbol 'custom-get)
211 (add-to-list 'cus-test-vars-with-custom-get symbol))
213 ;; Changed outside the customize buffer?
214 ;; This routine is not very much tested.
215 (let ((c-value
216 (or (get symbol 'customized-value)
217 (get symbol 'saved-value)
218 (get symbol 'standard-value))))
219 (and (consp c-value)
220 (boundp symbol)
221 (not (equal (eval (car c-value)) (symbol-value symbol)))
222 (add-to-list 'cus-test-vars-with-changed-state symbol)))
224 (if mismatch
225 (push symbol cus-test-errors)))
227 (error
228 (push symbol cus-test-errors)
229 (message "Error for %s: %s" symbol alpha))))
230 (cus-test-get-options regexp))
231 (message "%s options tested"
232 (length cus-test-tested-variables))
233 (cus-test-errors-display))
235 (defun cus-test-cus-load-groups (&optional cus-load)
236 "Return a list of current custom groups.
237 If CUS-LOAD is non-nil, include groups from cus-load.el."
238 (append (mapcar 'cdr custom-current-group-alist)
239 (if cus-load
240 (with-temp-buffer
241 (insert-file-contents (locate-library "cus-load.el"))
242 (search-forward "(put '")
243 (beginning-of-line)
244 (let (res)
245 (while (and (looking-at "^(put '\\(\\S-+\\)")
246 (zerop (forward-line 1)))
247 (push (intern (match-string 1)) res))
248 res)))))
250 (defun cus-test-get-options (regexp &optional group)
251 "Return a list of custom options matching REGEXP.
252 If GROUP is non-nil, return groups rather than options.
253 If GROUP is `cus-load', include groups listed in cus-loads as well as
254 currently defined groups."
255 (let ((groups (if group (cus-test-cus-load-groups (eq group 'cus-load))))
256 found)
257 (mapatoms
258 (lambda (symbol)
259 (and
260 (if group
261 (memq symbol groups)
263 ;; (user-variable-p symbol)
264 (get symbol 'standard-value)
265 ;; (get symbol 'saved-value)
266 (get symbol 'custom-type)))
267 (string-match regexp (symbol-name symbol))
268 (not (member symbol cus-test-skip-list))
269 (push symbol found))))
270 found))
272 (defun cus-test-errors-display ()
273 "Report about the errors found by cus-test."
274 (with-output-to-temp-buffer "*cus-test-errors*"
275 (set-buffer standard-output)
276 (insert (format "Cus Test tested %s variables.\
277 See `cus-test-tested-variables'.\n\n"
278 (length cus-test-tested-variables)))
279 (if (not cus-test-errors)
280 (insert "No errors found by cus-test.")
281 (insert "The following variables seem to have problems:\n\n")
282 (dolist (e cus-test-errors)
283 (insert (symbol-name e) "\n")))))
285 (defun cus-test-load-custom-loads ()
286 "Call `custom-load-symbol' on all atoms."
287 (interactive)
288 (if noninteractive (let (noninteractive) (require 'dunnet)))
289 (mapatoms 'custom-load-symbol)
290 (run-hooks 'cus-test-after-load-libs-hook))
292 (defmacro cus-test-load-1 (&rest body)
293 `(progn
294 (setq cus-test-libs-errors nil
295 cus-test-libs-loaded nil)
296 ,@body
297 (message "%s libraries loaded successfully"
298 (length cus-test-libs-loaded))
299 (if (not cus-test-libs-errors)
300 (message "No load problems encountered")
301 (message "The following load problems appeared:")
302 (cus-test-message cus-test-libs-errors))
303 (run-hooks 'cus-test-after-load-libs-hook)))
305 ;; This is just cus-test-libs, but loading in the current Emacs process.
306 (defun cus-test-load-libs (&optional more)
307 "Load the libraries with autoloads.
308 Don't load libraries in `cus-test-libs-noloads'.
309 If optional argument MORE is \"defcustom\", load all files with defcustoms.
310 If it is \"all\", load all Lisp files."
311 (interactive)
312 (cus-test-load-1
313 (let ((lispdir (file-name-directory (locate-library "loaddefs"))))
314 (mapc
315 (lambda (file)
316 (condition-case alpha
317 (unless (member file cus-test-libs-noloads)
318 (load (file-name-sans-extension (expand-file-name file lispdir)))
319 (push file cus-test-libs-loaded))
320 (error
321 (push (cons file alpha) cus-test-libs-errors)
322 (message "Error for %s: %s" file alpha))))
323 (if more
324 (cus-test-get-lisp-files (equal more "all"))
325 (cus-test-get-autoload-deps))))))
327 (defun cus-test-get-autoload-deps ()
328 "Return the list of files with autoloads."
329 (with-temp-buffer
330 (insert-file-contents (locate-library "loaddefs"))
331 (let (files)
332 (while (search-forward "\n;;; Generated autoloads from " nil t)
333 (push (buffer-substring (match-end 0) (line-end-position)) files))
334 files)))
336 (defun cus-test-get-lisp-files (&optional all)
337 "Return list of all Lisp files with defcustoms.
338 Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
339 (let ((default-directory (expand-file-name "lisp/" source-directory))
340 (msg "Finding files..."))
341 (message "%s" msg)
342 (prog1
343 ;; Hack to remove leading "./".
344 (mapcar (lambda (e) (substring e 2))
345 (apply 'process-lines find-program
346 "-name" "obsolete" "-prune" "-o"
347 "-name" "[^.]*.el" ; ignore .dir-locals.el
348 (if all
349 '("-print")
350 (list "-exec" grep-program
351 "-l" "^[ \t]*(defcustom" "{}" "+"))))
352 (message "%sdone" msg))))
354 (defun cus-test-message (list)
355 "Print the members of LIST line by line."
356 (dolist (m list) (message "%s" m)))
359 ;;; The routines for batch mode:
361 (defun cus-test-opts (&optional all)
362 "Test custom options.
363 This function is suitable for batch mode. E.g., invoke
365 src/emacs -batch -l admin/cus-test.el -f cus-test-opts
367 in the Emacs source directory.
368 Normally only tests options belonging to files in loaddefs.el.
369 If optional argument ALL is non-nil, test all files with defcustoms."
370 (interactive)
371 (and noninteractive
372 command-line-args-left
373 (setq all (pop command-line-args-left)))
374 (message "Running %s" 'cus-test-load-libs)
375 (cus-test-load-libs (if all "defcustom"))
376 (message "Running %s" 'cus-test-load-custom-loads)
377 (cus-test-load-custom-loads)
378 (message "Running %s" 'cus-test-apropos)
379 (cus-test-apropos "")
380 (if (not cus-test-errors)
381 (message "No problems found")
382 (message "The following options might have problems:")
383 (cus-test-message cus-test-errors)))
385 (defun cus-test-deps ()
386 "Run a verbose version of `custom-load-symbol' on all atoms.
387 This function is suitable for batch mode. E.g., invoke
389 src/emacs -batch -l admin/cus-test.el -f cus-test-deps
391 in the Emacs source directory."
392 (interactive)
393 (setq cus-test-deps-errors nil)
394 (setq cus-test-deps-required nil)
395 (setq cus-test-deps-loaded nil)
396 (mapatoms
397 ;; This code is mainly from `custom-load-symbol'.
398 (lambda (symbol)
399 (let ((custom-load-recursion t))
400 (dolist (load (get symbol 'custom-loads))
401 (cond
402 ((symbolp load)
403 ;; (condition-case nil (require load) (error nil))
404 (condition-case alpha
405 (unless (or (featurep load)
406 (and noninteractive (eq load 'dunnet)))
407 (require load)
408 (push (list symbol load) cus-test-deps-required))
409 (error
410 (push (list symbol load alpha) cus-test-deps-errors)
411 (message "Require problem: %s %s %s" symbol load alpha))))
412 ((equal load "loaddefs")
413 (push
414 (message "Symbol %s has loaddefs as custom dependency" symbol)
415 cus-test-deps-errors))
416 ;; This is subsumed by the test below, but it's much
417 ;; faster.
418 ((assoc load load-history))
419 ;; This was just
420 ;; (assoc (locate-library load) load-history)
421 ;; but has been optimized not to load locate-library
422 ;; if not necessary.
423 ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
424 "\\(\\'\\|\\.\\)"))
425 (found nil))
426 (dolist (loaded load-history)
427 (and (stringp (car loaded))
428 (string-match regexp (car loaded))
429 (setq found t)))
430 found))
431 ;; Without this, we would load cus-edit recursively.
432 ;; We are still loading it when we call this,
433 ;; and it is not in load-history yet.
434 ((equal load "cus-edit"))
435 ;; This would ignore load problems with files in
436 ;; lisp/term/
437 ;; ((locate-library (concat term-file-prefix load)))
439 ;; (condition-case nil (load load) (error nil))
440 (condition-case alpha
441 (progn
442 (load load)
443 (push (list symbol load) cus-test-deps-loaded))
444 (error
445 (push (list symbol load alpha) cus-test-deps-errors)
446 (message "Load Problem: %s %s %s" symbol load alpha))))
447 )))))
448 (message "%s features required"
449 (length cus-test-deps-required))
450 (message "%s files loaded"
451 (length cus-test-deps-loaded))
452 (if (not cus-test-deps-errors)
453 (message "No load problems encountered")
454 (message "The following load problems appeared:")
455 (cus-test-message cus-test-deps-errors))
456 (run-hooks 'cus-test-after-load-libs-hook))
458 (defun cus-test-libs (&optional more)
459 "Load the libraries with autoloads in separate processes.
460 This function is useful to detect load problems of libraries.
461 It is suitable for batch mode. E.g., invoke
463 ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs
465 in the Emacs source directory.
467 If optional argument MORE is \"defcustom\", load all files with defcustoms.
468 If it is \"all\", load all Lisp files."
469 (interactive)
470 (and noninteractive
471 command-line-args-left
472 (setq more (pop command-line-args-left)))
473 (cus-test-load-1
474 (let* ((default-directory source-directory)
475 (emacs (expand-file-name "src/emacs"))
476 skipped)
477 (or (file-executable-p emacs)
478 (error "No such executable `%s'" emacs))
479 (mapc
480 (lambda (file)
481 (if (member file cus-test-libs-noloads)
482 (push file skipped)
483 (condition-case alpha
484 (let* ((fn (expand-file-name file "lisp/"))
485 (elc (concat fn "c"))
486 status)
487 (if (file-readable-p elc) ; load compiled if present (faster)
488 (setq fn elc)
489 (or (file-readable-p fn)
490 (error "Library %s not found" file)))
491 (if (equal 0 (setq status (call-process emacs nil nil nil
492 "-batch" "-l" fn)))
493 (message "%s" file)
494 (error "%s" status))
495 (push file cus-test-libs-loaded))
496 (error
497 (push (cons file alpha) cus-test-libs-errors)
498 (message "Error for %s: %s" file alpha)))))
499 (if more
500 (cus-test-get-lisp-files (equal more "all"))
501 (cus-test-get-autoload-deps)))
502 (message "Default directory: %s" default-directory)
503 (when skipped
504 (message "The following libraries were skipped:")
505 (cus-test-message skipped)))))
507 (defun cus-test-noloads ()
508 "Find custom options not loaded by `custom-load-symbol'.
509 Calling this function after `cus-test-load-libs' is not meaningful.
510 It is suitable for batch mode. E.g., invoke
512 src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
514 in the Emacs source directory."
515 (interactive)
516 (let ((groups-loaded (cus-test-get-options "" 'cus-load))
517 cus-loaded groups-not-loaded)
519 (message "Running %s" 'cus-test-load-custom-loads)
520 (cus-test-load-custom-loads)
521 (setq cus-loaded (cus-test-get-options ""))
523 (message "Running %s" 'cus-test-load-libs)
524 (cus-test-load-libs "all")
525 (setq cus-test-vars-not-cus-loaded (cus-test-get-options "")
526 groups-not-loaded (cus-test-get-options "" t))
528 (dolist (o cus-loaded)
529 (setq cus-test-vars-not-cus-loaded
530 (delete o cus-test-vars-not-cus-loaded)))
532 (if (not cus-test-vars-not-cus-loaded)
533 (message "No options not loaded by custom-load-symbol found")
534 (message "The following options were not loaded by custom-load-symbol:")
535 (cus-test-message
536 (sort cus-test-vars-not-cus-loaded 'string<)))
538 (dolist (o groups-loaded)
539 (setq groups-not-loaded (delete o groups-not-loaded)))
541 (if (not groups-not-loaded)
542 (message "No groups not in cus-load.el found")
543 (message "The following groups are not in cus-load.el:")
544 (cus-test-message (sort groups-not-loaded 'string<)))))
546 (provide 'cus-test)
548 ;;; cus-test.el ends here