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