admin/cus-test.el

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