admin/cus-test.el

   1 ;;; cus-test.el --- tests for custom types and load problems
   2
   3 ;; Copyright (C) 1998, 2000, 2002, 2003, 2004, 2005, 2006  Free
   4 ;;   Software Foundation, Inc.
   5
   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
  10
  11 ;; This file is part of GNU Emacs.
  12
  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 2, or (at your option)
  16 ;; any later version.
  17
  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.
  22
  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.
  27
  28 ;;; Commentary:
  29
  30 ;; This file provides simple tests to detect custom options with
  31 ;; incorrect customization types and load problems for custom and
  32 ;; autoload dependencies.
  33 ;;
  34 ;; The basic tests can be run in batch mode.  Invoke them with
  35 ;;
  36 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
  37 ;;
  38 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
  39 ;;
  40 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-libs
  41 ;;
  42 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
  43 ;;
  44 ;; in the emacs source directory.
  45 ;;
  46 ;; For interactive use: Load this file.  Then
  47 ;;
  48 ;;    M-x cus-test-apropos REGEXP RET
  49 ;;
  50 ;; checks the options matching REGEXP.  In particular
  51 ;;
  52 ;;    M-x cus-test-apropos RET
  53 ;;
  54 ;; checks all options.  The detected options are stored in the
  55 ;; variable `cus-test-errors'.
  56 ;;
  57 ;; Only those options are checked which have been already loaded.
  58 ;; Therefore `cus-test-apropos' is more efficient after loading many
  59 ;; libraries.
  60 ;;
  61 ;;    M-x cus-test-load-custom-loads
  62 ;;
  63 ;; loads all (!) custom dependencies and
  64 ;;
  65 ;;    M-x cus-test-load-libs
  66 ;;
  67 ;; loads all (!) libraries with autoloads.
  68 ;;
  69 ;; Options with a custom-get property, usually defined by a :get
  70 ;; declaration, are stored in the variable
  71 ;;
  72 ;; `cus-test-vars-with-custom-get'
  73 ;;
  74 ;; Options with a state of 'changed ("changed outside the customize
  75 ;; buffer") are stored in the variable
  76 ;;
  77 ;; `cus-test-vars-with-changed-state'
  78 ;;
  79 ;; These lists are prepared just in case one wants to investigate
  80 ;; those options further.
  81 ;;
  82 ;; The command `cus-test-opts' tests many (all?) custom options.
  83 ;;
  84 ;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
  85 ;; but reports about load errors.
  86 ;;
  87 ;; The command `cus-test-libs' runs for all libraries with autoloads
  88 ;; separate emacs processes of the form "emacs -batch -l LIB".
  89 ;;
  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'.
  93 ;;
  94 ;; Some results from October 2002:
  95 ;;
  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
 101 ;;
 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 ;; ...
 112 ;;
 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)
 118 ;;
 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
 130
 131 \f
 132 ;;; Code:
 133
 134 ;;; Workarounds.  For a smooth run and to avoid some side effects.
 135
 136 (defvar cus-test-after-load-libs-hook nil
 137   "Used to switch off undesired side effects of loading libraries.")
 138
 139 (defvar cus-test-skip-list nil
 140   "List of variables to disregard by `cus-test-apropos'.")
 141
 142 (defvar cus-test-libs-noloads nil
 143   "List of libraries not to load by `cus-test-load-libs'.")
 144
 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)
 150
 151 ;; This avoids a hang of `cus-test-apropos' in 21.2.
 152 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
 153
 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")
 157
 158 ;; Never Viperize.
 159 (setq viper-mode nil)
 160
 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))
 164
 165 ;; Don't create a file `abbrev-file-name'.
 166 (setq save-abbrevs nil)
 167
 168 ;; Avoid compile logs from adviced functions.
 169 (eval-after-load "bytecomp"
 170   '(setq ad-default-compilation-action 'never))
 171
 172 \f
 173 ;;; Main code:
 174
 175 ;; We want to log all messages.
 176 (setq message-log-max t)
 177
 178 (require 'cus-edit)
 179 (require 'cus-load)
 180
 181 (defvar cus-test-errors nil
 182   "List of problematic variables found by `cus-test-apropos'.")
 183
 184 (defvar cus-test-tested-variables nil
 185   "List of options tested by last call of `cus-test-apropos'.")
 186
 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.")
 191
 192 (defvar cus-test-vars-with-changed-state nil
 193   "Set by `cus-test-apropos' to a list of options with state 'changed.")
 194
 195 (defvar cus-test-deps-errors nil
 196   "List of require/load problems found by `cus-test-deps'.")
 197
 198 (defvar cus-test-deps-required nil
 199   "List of dependencies required by `cus-test-deps'.
 200 Only unloaded features will be require'd.")
 201
 202 (defvar cus-test-deps-loaded nil
 203   "List of dependencies loaded by `cus-test-deps'.")
 204
 205 (defvar cus-test-libs-errors nil
 206   "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
 207
 208 (defvar cus-test-libs-loaded nil
 209   "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
 210
 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'.")
 214
 215 ;; (defvar cus-test-vars-cus-loaded nil
 216 ;;   "A list of options loaded by `custom-load-symbol'.")
 217
 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)
 243
 244            ;; Check the values
 245            (mapc (lambda (value)
 246                    (unless (widget-apply conv :match value)
 247                      (setq mismatch 'mismatch)))
 248                  values)
 249
 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))
 253
 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)))
 264
 265            (if mismatch
 266                (push symbol cus-test-errors)))
 267
 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))
 275
 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
 282         (or
 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))
 291
 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")))))
 304
 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))
 310
 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))
 334
 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)))
 351
 352 (defun cus-test-message (list)
 353   "Print the members of LIST line by line."
 354   (dolist (m list) (message "%s" m)))
 355
 356 \f
 357 ;;; The routines for batch mode:
 358
 359 (defun cus-test-opts ()
 360   "Test custom options.
 361 This function is suitable for batch mode.  E.g., invoke
 362
 363   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
 364
 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)))
 377
 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
 381
 382   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
 383
 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)))
 430           (t
 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))
 449
 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
 454
 455   src/emacs -batch -l admin/cus-test.el -f cus-test-libs
 456
 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)))
 491
 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
 496
 497   src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
 498
 499 in the Emacs source directory."
 500   (interactive)
 501   (let (cus-loaded)
 502
 503     (message "Running %s" 'cus-test-load-custom-loads)
 504     (cus-test-load-custom-loads)
 505     (setq cus-loaded
 506           (cus-test-get-options ""))
 507
 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 ""))
 512
 513     (dolist (o cus-loaded)
 514       (setq cus-test-vars-not-cus-loaded
 515             (delete o cus-test-vars-not-cus-loaded)))
 516
 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<)))))
 522
 523 ;; And last but not least a quiz:
 524 ;;
 525 ;; Evaluation of the form (customize-option 'debug-on-error) yields a
 526 ;; *Customize* buffer with a mismatch mess.  Why?
 527
 528 (provide 'cus-test)
 529
 530 ;;; arch-tag: a4991a31-548d-48fb-8ba1-1ebbe68eb2e7
 531 ;;; cus-test.el ends here