(byte-compile-warn-obsolete): New function.
[emacs.git] / admin / cus-test.el
blob96fae1f70e4d9d4cd46e01323aedfd667db2098d
1 ;;; cus-test.el --- tests for custom types and load problems
3 ;; Copyright (C) 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 ;; Free Software Foundation, Inc.
6 ;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
7 ;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
8 ;; Created: 13 Sep 1998
9 ;; Keywords: maint
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
16 ;; any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
28 ;;; Commentary:
30 ;; This file provides simple tests to detect custom options with
31 ;; incorrect customization types and load problems for custom and
32 ;; autoload dependencies.
34 ;; The basic tests can be run in batch mode. Invoke them with
36 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts
38 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps
40 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs
42 ;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
44 ;; in the emacs source directory.
46 ;; For interactive use: Load this file. Then
48 ;; M-x cus-test-apropos REGEXP RET
50 ;; checks the options matching REGEXP. In particular
52 ;; M-x cus-test-apropos RET
54 ;; checks all options. The detected options are stored in the
55 ;; variable `cus-test-errors'.
57 ;; Only those options are checked which have been already loaded.
58 ;; Therefore `cus-test-apropos' is more efficient after loading many
59 ;; libraries.
61 ;; M-x cus-test-load-custom-loads
63 ;; loads all (!) custom dependencies and
65 ;; M-x cus-test-load-libs
67 ;; loads all (!) libraries with autoloads.
69 ;; Options with a custom-get property, usually defined by a :get
70 ;; declaration, are stored in the variable
72 ;; `cus-test-vars-with-custom-get'
74 ;; Options with a state of 'changed ("changed outside the customize
75 ;; buffer") are stored in the variable
77 ;; `cus-test-vars-with-changed-state'
79 ;; These lists are prepared just in case one wants to investigate
80 ;; those options further.
82 ;; The command `cus-test-opts' tests many (all?) custom options.
84 ;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
85 ;; but reports about load errors.
87 ;; The command `cus-test-libs' runs for all libraries with autoloads
88 ;; separate emacs processes of the form "emacs -batch -l LIB".
90 ;; The command `cus-test-noloads' returns a list of variables which
91 ;; are somewhere declared as custom options, but not loaded by
92 ;; `custom-load-symbol'.
94 ;; Some results from October 2002:
96 ;; 4523 options tested
97 ;; The following variables might have problems:
98 ;; ps-mule-font-info-database-default
99 ;; grep-tree-command
100 ;; grep-find-command
102 ;; 288 features required
103 ;; 10 files loaded
104 ;; The following load problems appeared:
105 ;; (killing x-win (file-error Cannot open load file x-win))
106 ;; Symbol faces has loaddefs as custom dependency
107 ;; (reftex-index-support reftex-vars (void-function reftex-set-dirty))
108 ;; (eshell-script em-script (void-variable eshell-directory-name))
109 ;; (pcomplete em-cmpl (void-function eshell-under-windows-p))
110 ;; (eshell-ext esh-ext (void-function eshell-under-windows-p))
111 ;; ...
113 ;; 422 libraries had no load errors
114 ;; The following load problems appeared:
115 ;; (eudc-export error 255)
116 ;; (ada-xref error 255)
117 ;; (ada-stmt error 255)
119 ;; The following options were not loaded by custom-load-symbol:
120 ;; edt-bottom-scroll-margin
121 ;; edt-keep-current-page-delimiter
122 ;; edt-top-scroll-margin
123 ;; edt-use-EDT-control-key-bindings
124 ;; edt-word-entities
125 ;; grep-find-use-xargs
126 ;; master-mode-hook
127 ;; outline-level
128 ;; outline-minor-mode-hook
129 ;; refill-mode-hook
132 ;;; Code:
134 ;;; Workarounds. For a smooth run and to avoid some side effects.
136 (defvar cus-test-after-load-libs-hook nil
137 "Used to switch off undesired side effects of loading libraries.")
139 (defvar cus-test-skip-list nil
140 "List of variables to disregard by `cus-test-apropos'.")
142 (defvar cus-test-libs-noloads nil
143 "List of libraries not to load by `cus-test-load-libs'.")
145 ;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which
146 ;; are not part of GNU Emacs: (locate-library "bbdb") => nil
147 ;; We avoid the resulting errors from loading eudc-export.el:
148 (provide 'bbdb)
149 (provide 'bbdb-com)
151 ;; This avoids a hang of `cus-test-apropos' in 21.2.
152 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
154 ;; Loading dunnet in batch mode leads to a Dead end.
155 (let (noninteractive) (load "dunnet"))
156 (add-to-list 'cus-test-libs-noloads "dunnet")
158 ;; Never Viperize.
159 (setq viper-mode nil)
161 ;; Don't create a file `save-place-file'.
162 (eval-after-load "saveplace"
163 '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
165 ;; Don't create a file `abbrev-file-name'.
166 (setq save-abbrevs nil)
168 ;; Avoid compile logs from adviced functions.
169 (eval-after-load "bytecomp"
170 '(setq ad-default-compilation-action 'never))
173 ;;; Main code:
175 ;; We want to log all messages.
176 (setq message-log-max t)
178 (require 'cus-edit)
179 (require 'cus-load)
181 (defvar cus-test-errors nil
182 "List of problematic variables found by `cus-test-apropos'.")
184 (defvar cus-test-tested-variables nil
185 "List of options tested by last call of `cus-test-apropos'.")
187 ;; I haven't understood this :get stuff. The symbols with a
188 ;; custom-get property are stored here.
189 (defvar cus-test-vars-with-custom-get nil
190 "Set by `cus-test-apropos' to a list of options with :get property.")
192 (defvar cus-test-vars-with-changed-state nil
193 "Set by `cus-test-apropos' to a list of options with state 'changed.")
195 (defvar cus-test-deps-errors nil
196 "List of require/load problems found by `cus-test-deps'.")
198 (defvar cus-test-deps-required nil
199 "List of dependencies required by `cus-test-deps'.
200 Only unloaded features will be require'd.")
202 (defvar cus-test-deps-loaded nil
203 "List of dependencies loaded by `cus-test-deps'.")
205 (defvar cus-test-libs-errors nil
206 "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
208 (defvar cus-test-libs-loaded nil
209 "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
211 (defvar cus-test-vars-not-cus-loaded nil
212 "A list of options not loaded by `custom-load-symbol'.
213 Set by `cus-test-noloads'.")
215 ;; (defvar cus-test-vars-cus-loaded nil
216 ;; "A list of options loaded by `custom-load-symbol'.")
218 (defun cus-test-apropos (regexp)
219 "Check the options matching REGEXP.
220 The detected problematic options are stored in `cus-test-errors'."
221 (interactive "sVariable regexp: ")
222 (setq cus-test-errors nil)
223 (setq cus-test-tested-variables nil)
224 (mapc
225 (lambda (symbol)
226 (push symbol cus-test-tested-variables)
227 ;; Be verbose in case we hang.
228 (message "Cus Test running...%s %s"
229 (length cus-test-tested-variables) symbol)
230 (condition-case alpha
231 (let* ((type (custom-variable-type symbol))
232 (conv (widget-convert type))
233 (get (or (get symbol 'custom-get) 'default-value))
234 values
235 mismatch)
236 (when (default-boundp symbol)
237 (push (funcall get symbol) values)
238 (push (eval (car (get symbol 'standard-value))) values))
239 (if (boundp symbol)
240 (push (symbol-value symbol) values))
241 ;; That does not work.
242 ;; (push (widget-get conv :value) values)
244 ;; Check the values
245 (mapc (lambda (value)
246 (unless (widget-apply conv :match value)
247 (setq mismatch 'mismatch)))
248 values)
250 ;; Store symbols with a custom-get property.
251 (when (get symbol 'custom-get)
252 (add-to-list 'cus-test-vars-with-custom-get symbol))
254 ;; Changed outside the customize buffer?
255 ;; This routine is not very much tested.
256 (let ((c-value
257 (or (get symbol 'customized-value)
258 (get symbol 'saved-value)
259 (get symbol 'standard-value))))
260 (and (consp c-value)
261 (boundp symbol)
262 (not (equal (eval (car c-value)) (symbol-value symbol)))
263 (add-to-list 'cus-test-vars-with-changed-state symbol)))
265 (if mismatch
266 (push symbol cus-test-errors)))
268 (error
269 (push symbol cus-test-errors)
270 (message "Error for %s: %s" symbol alpha))))
271 (cus-test-get-options regexp))
272 (message "%s options tested"
273 (length cus-test-tested-variables))
274 (cus-test-errors-display))
276 (defun cus-test-get-options (regexp)
277 "Return a list of custom options matching REGEXP."
278 (let (found)
279 (mapatoms
280 (lambda (symbol)
281 (and
283 ;; (user-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))))
290 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 (symbol-name e) "\n")))))
305 (defun cus-test-load-custom-loads ()
306 "Call `custom-load-symbol' on all atoms."
307 (interactive)
308 (mapatoms 'custom-load-symbol)
309 (run-hooks 'cus-test-after-load-libs-hook))
311 (defun cus-test-load-libs ()
312 "Load the libraries with autoloads.
313 Don't load libraries in `cus-test-libs-noloads'."
314 (interactive)
315 (setq cus-test-libs-errors nil)
316 (setq cus-test-libs-loaded nil)
317 (mapc
318 (lambda (file)
319 (condition-case alpha
320 (unless (member file cus-test-libs-noloads)
321 (load file)
322 (push file cus-test-libs-loaded))
323 (error
324 (push (cons file alpha) cus-test-libs-errors)
325 (message "Error for %s: %s" file alpha))))
326 (cus-test-get-autoload-deps))
327 (message "%s libraries loaded successfully"
328 (length cus-test-libs-loaded))
329 (if (not cus-test-libs-errors)
330 (message "No load problems encountered")
331 (message "The following load problems appeared:")
332 (cus-test-message cus-test-libs-errors))
333 (run-hooks 'cus-test-after-load-libs-hook))
335 (defun cus-test-get-autoload-deps ()
336 "Return the list of libraries with autoloads."
337 (with-temp-buffer
338 (insert-file-contents (locate-library "loaddefs"))
339 ;; This is from `customize-option'.
340 (let (deps file)
341 (while
342 (search-forward "\n;;; Generated autoloads from " nil t)
343 (goto-char (match-end 0))
344 (setq file (buffer-substring (point)
345 (progn (end-of-line) (point))))
346 (setq file (file-name-nondirectory file))
347 (string-match "\\.el\\'" file)
348 (setq file (substring file 0 (match-beginning 0)))
349 (setq deps (nconc deps (list file))))
350 deps)))
352 (defun cus-test-message (list)
353 "Print the members of LIST line by line."
354 (dolist (m list) (message "%s" m)))
357 ;;; The routines for batch mode:
359 (defun cus-test-opts ()
360 "Test custom options.
361 This function is suitable for batch mode. E.g., invoke
363 src/emacs -batch -l admin/cus-test.el -f cus-test-opts
365 in the Emacs source directory."
366 (interactive)
367 (message "Running %s" 'cus-test-load-libs)
368 (cus-test-load-libs)
369 (message "Running %s" 'cus-test-load-custom-loads)
370 (cus-test-load-custom-loads)
371 (message "Running %s" 'cus-test-apropos)
372 (cus-test-apropos "")
373 (if (not cus-test-errors)
374 (message "No problems found")
375 (message "The following options might have problems:")
376 (cus-test-message cus-test-errors)))
378 (defun cus-test-deps ()
379 "Run a verbose version of `custom-load-symbol' on all atoms.
380 This function is suitable for batch mode. E.g., invoke
382 src/emacs -batch -l admin/cus-test.el -f cus-test-deps
384 in the Emacs source directory."
385 (interactive)
386 (setq cus-test-deps-errors nil)
387 (setq cus-test-deps-required nil)
388 (setq cus-test-deps-loaded nil)
389 (mapatoms
390 ;; This code is mainly from `custom-load-symbol'.
391 (lambda (symbol)
392 (let ((custom-load-recursion t))
393 (dolist (load (get symbol 'custom-loads))
394 (cond
395 ((symbolp load)
396 ;; (condition-case nil (require load) (error nil))
397 (condition-case alpha
398 (unless (featurep load)
399 (require load)
400 (push (list symbol load) cus-test-deps-required))
401 (error
402 (push (list symbol load alpha) cus-test-deps-errors)
403 (message "Require problem: %s %s %s" symbol load alpha))))
404 ((equal load "loaddefs")
405 (push
406 (message "Symbol %s has loaddefs as custom dependency" symbol)
407 cus-test-deps-errors))
408 ;; This is subsumed by the test below, but it's much
409 ;; faster.
410 ((assoc load load-history))
411 ;; This was just
412 ;; (assoc (locate-library load) load-history)
413 ;; but has been optimized not to load locate-library
414 ;; if not necessary.
415 ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
416 "\\(\\'\\|\\.\\)"))
417 (found nil))
418 (dolist (loaded load-history)
419 (and (stringp (car loaded))
420 (string-match regexp (car loaded))
421 (setq found t)))
422 found))
423 ;; Without this, we would load cus-edit recursively.
424 ;; We are still loading it when we call this,
425 ;; and it is not in load-history yet.
426 ((equal load "cus-edit"))
427 ;; This would ignore load problems with files in
428 ;; lisp/term/
429 ;; ((locate-library (concat term-file-prefix load)))
431 ;; (condition-case nil (load load) (error nil))
432 (condition-case alpha
433 (progn
434 (load load)
435 (push (list symbol load) cus-test-deps-loaded))
436 (error
437 (push (list symbol load alpha) cus-test-deps-errors)
438 (message "Load Problem: %s %s %s" symbol load alpha))))
439 )))))
440 (message "%s features required"
441 (length cus-test-deps-required))
442 (message "%s files loaded"
443 (length cus-test-deps-loaded))
444 (if (not cus-test-deps-errors)
445 (message "No load problems encountered")
446 (message "The following load problems appeared:")
447 (cus-test-message cus-test-deps-errors))
448 (run-hooks 'cus-test-after-load-libs-hook))
450 (defun cus-test-libs ()
451 "Load the libraries with autoloads in separate processes.
452 This function is useful to detect load problems of libraries.
453 It is suitable for batch mode. E.g., invoke
455 src/emacs -batch -l admin/cus-test.el -f cus-test-libs
457 in the Emacs source directory."
458 (interactive)
459 (with-temp-buffer
460 (setq cus-test-libs-errors nil)
461 (setq cus-test-libs-loaded nil)
462 (cd source-directory)
463 (if (not (file-executable-p "src/emacs"))
464 (error "No Emacs executable in %ssrc" default-directory))
465 (mapc
466 (lambda (file)
467 (condition-case alpha
468 (let (fn cmd status)
469 (setq fn (locate-library file))
470 (if (not fn)
471 (error "Library %s not found" file))
472 (setq cmd (concat "src/emacs -batch -l " fn))
473 (setq status (call-process shell-file-name nil nil nil
474 shell-command-switch cmd))
475 (if (equal status 0)
476 (message "%s" file)
477 (error "%s" status))
478 (push file cus-test-libs-loaded))
479 (error
480 (push (cons file alpha) cus-test-libs-errors)
481 (message "Error for %s: %s" file alpha))))
482 (cus-test-get-autoload-deps))
483 (message "Default Directory: %s" default-directory)
484 (message "%s libraries had no load errors"
485 (length cus-test-libs-loaded))
486 (if (not cus-test-libs-errors)
487 (message "No load problems encountered")
488 (message "The following load problems appeared:")
489 (cus-test-message cus-test-libs-errors))
490 (run-hooks 'cus-test-after-load-libs-hook)))
492 (defun cus-test-noloads ()
493 "Find custom options not loaded by `custom-load-symbol'.
494 Calling this function after `cus-test-load-libs' is not meaningful.
495 It is suitable for batch mode. E.g., invoke
497 src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
499 in the Emacs source directory."
500 (interactive)
501 (let (cus-loaded)
503 (message "Running %s" 'cus-test-load-custom-loads)
504 (cus-test-load-custom-loads)
505 (setq cus-loaded
506 (cus-test-get-options ""))
508 (message "Running %s" 'cus-test-load-libs)
509 (cus-test-load-libs)
510 (setq cus-test-vars-not-cus-loaded
511 (cus-test-get-options ""))
513 (dolist (o cus-loaded)
514 (setq cus-test-vars-not-cus-loaded
515 (delete o cus-test-vars-not-cus-loaded)))
517 (if (not cus-test-vars-not-cus-loaded)
518 (message "No options not loaded by custom-load-symbol found")
519 (message "The following options were not loaded by custom-load-symbol:")
520 (cus-test-message
521 (sort cus-test-vars-not-cus-loaded 'string<)))))
523 ;; And last but not least a quiz:
525 ;; Evaluation of the form (customize-option 'debug-on-error) yields a
526 ;; *Customize* buffer with a mismatch mess. Why?
528 (provide 'cus-test)
530 ;;; arch-tag: a4991a31-548d-48fb-8ba1-1ebbe68eb2e7
531 ;;; cus-test.el ends here