code.delx.au - gnu-emacs/blob - admin/cus-test.el

   1 ;;; cus-test.el --- tests for custom types and load problems
   2
   3 ;; Copyright (C) 1998, 2000, 2002-2013 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 \f
  92 ;;; Code:
  93
  94 ;;; Workarounds.  For a smooth run and to avoid some side effects.
  95
  96 (defvar cus-test-after-load-libs-hook nil
  97   "Used to switch off undesired side effects of loading libraries.")
  98
  99 (defvar cus-test-skip-list nil
 100   "List of variables to disregard by `cus-test-apropos'.")
 101
 102 ;; Loading dunnet in batch mode leads to a Dead end.
 103 (defvar cus-test-libs-noloads '("play/dunnet.el")
 104   "List of files not to load by `cus-test-load-libs'.
 105 Names should be as they appear in loaddefs.el.")
 106
 107 ;; This avoids a hang of `cus-test-apropos' in 21.2.
 108 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
 109
 110 (or noninteractive
 111     ;; Never Viperize.
 112     (setq viper-mode nil))
 113
 114 ;; Don't create a file `save-place-file'.
 115 (eval-after-load "saveplace"
 116   '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
 117
 118 ;; Don't create a file `abbrev-file-name'.
 119 (setq save-abbrevs nil)
 120
 121 ;; Avoid compile logs from adviced functions.
 122 (eval-after-load "bytecomp"
 123   '(setq ad-default-compilation-action 'never))
 124
 125 \f
 126 ;;; Main code:
 127
 128 ;; We want to log all messages.
 129 (setq message-log-max t)
 130
 131 (require 'cus-edit)
 132 (require 'cus-load)
 133
 134 (defvar cus-test-errors nil
 135   "List of problematic variables found by `cus-test-apropos'.")
 136
 137 (defvar cus-test-tested-variables nil
 138   "List of options tested by last call of `cus-test-apropos'.")
 139
 140 ;; I haven't understood this :get stuff.  The symbols with a
 141 ;; custom-get property are stored here.
 142 (defvar cus-test-vars-with-custom-get nil
 143   "Set by `cus-test-apropos' to a list of options with :get property.")
 144
 145 (defvar cus-test-vars-with-changed-state nil
 146   "Set by `cus-test-apropos' to a list of options with state 'changed.")
 147
 148 (defvar cus-test-deps-errors nil
 149   "List of require/load problems found by `cus-test-deps'.")
 150
 151 (defvar cus-test-deps-required nil
 152   "List of dependencies required by `cus-test-deps'.
 153 Only unloaded features will be require'd.")
 154
 155 (defvar cus-test-deps-loaded nil
 156   "List of dependencies loaded by `cus-test-deps'.")
 157
 158 (defvar cus-test-libs-errors nil
 159   "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
 160
 161 (defvar cus-test-libs-loaded nil
 162   "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
 163
 164 (defvar cus-test-vars-not-cus-loaded nil
 165   "A list of options not loaded by `custom-load-symbol'.
 166 Set by `cus-test-noloads'.")
 167
 168 ;; (defvar cus-test-vars-cus-loaded nil
 169 ;;   "A list of options loaded by `custom-load-symbol'.")
 170
 171 (defun cus-test-apropos (regexp)
 172   "Check the options matching REGEXP.
 173 The detected problematic options are stored in `cus-test-errors'."
 174   (interactive "sVariable regexp: ")
 175   (setq cus-test-errors nil)
 176   (setq cus-test-tested-variables nil)
 177   (mapc
 178    (lambda (symbol)
 179      (push symbol cus-test-tested-variables)
 180      ;; Be verbose in case we hang.
 181      (message "Cus Test running...%s %s"
 182               (length cus-test-tested-variables) symbol)
 183      (condition-case alpha
 184          (let* ((type (custom-variable-type symbol))
 185                 (conv (widget-convert type))
 186                 (get (or (get symbol 'custom-get) 'default-value))
 187                 values
 188                 mismatch)
 189            (when (default-boundp symbol)
 190              (push (funcall get symbol) values)
 191              (push (eval (car (get symbol 'standard-value))) values))
 192            (if (boundp symbol)
 193                (push (symbol-value symbol) values))
 194            ;; That does not work.
 195            ;; (push (widget-get conv :value) values)
 196
 197            ;; Check the values
 198            (mapc (lambda (value)
 199                    (unless (widget-apply conv :match value)
 200                      (setq mismatch 'mismatch)))
 201                  values)
 202
 203            ;; Store symbols with a custom-get property.
 204            (when (get symbol 'custom-get)
 205              (add-to-list 'cus-test-vars-with-custom-get symbol))
 206
 207            ;; Changed outside the customize buffer?
 208            ;; This routine is not very much tested.
 209            (let ((c-value
 210                   (or (get symbol 'customized-value)
 211                       (get symbol 'saved-value)
 212                       (get symbol 'standard-value))))
 213              (and (consp c-value)
 214                   (boundp symbol)
 215                   (not (equal (eval (car c-value)) (symbol-value symbol)))
 216                   (add-to-list 'cus-test-vars-with-changed-state symbol)))
 217
 218            (if mismatch
 219                (push symbol cus-test-errors)))
 220
 221        (error
 222         (push symbol cus-test-errors)
 223         (message "Error for %s: %s" symbol alpha))))
 224    (cus-test-get-options regexp))
 225   (message "%s options tested"
 226            (length cus-test-tested-variables))
 227   (cus-test-errors-display))
 228
 229 (defun cus-test-get-options (regexp)
 230   "Return a list of custom options matching REGEXP."
 231   (let (found)
 232     (mapatoms
 233      (lambda (symbol)
 234        (and
 235         (or
 236          ;; (user-variable-p symbol)
 237          (get symbol 'standard-value)
 238          ;; (get symbol 'saved-value)
 239          (get symbol 'custom-type))
 240         (string-match regexp (symbol-name symbol))
 241         (not (member symbol cus-test-skip-list))
 242         (push symbol found))))
 243     found))
 244
 245 (defun cus-test-errors-display ()
 246   "Report about the errors found by cus-test."
 247   (with-output-to-temp-buffer "*cus-test-errors*"
 248     (set-buffer standard-output)
 249     (insert (format "Cus Test tested %s variables.\
 250   See `cus-test-tested-variables'.\n\n"
 251                     (length cus-test-tested-variables)))
 252     (if (not cus-test-errors)
 253         (insert "No errors found by cus-test.")
 254       (insert "The following variables seem to have problems:\n\n")
 255       (dolist (e cus-test-errors)
 256         (insert (symbol-name e) "\n")))))
 257
 258 (defun cus-test-load-custom-loads ()
 259   "Call `custom-load-symbol' on all atoms."
 260   (interactive)
 261   (if noninteractive (let (noninteractive) (require 'dunnet)))
 262   (mapatoms 'custom-load-symbol)
 263   (run-hooks 'cus-test-after-load-libs-hook))
 264
 265 (defmacro cus-test-load-1 (&rest body)
 266   `(progn
 267      (setq cus-test-libs-errors nil
 268            cus-test-libs-loaded nil)
 269      ,@body
 270      (message "%s libraries loaded successfully"
 271               (length cus-test-libs-loaded))
 272      (if (not cus-test-libs-errors)
 273          (message "No load problems encountered")
 274        (message "The following load problems appeared:")
 275        (cus-test-message cus-test-libs-errors))
 276      (run-hooks 'cus-test-after-load-libs-hook)))
 277
 278 ;; This is just cus-test-libs, but loading in the current Emacs process.
 279 (defun cus-test-load-libs ()
 280   "Load the libraries with autoloads.
 281 Don't load libraries in `cus-test-libs-noloads'."
 282   (interactive)
 283   (cus-test-load-1
 284    (let ((lispdir (file-name-directory (locate-library "loaddefs"))))
 285      (mapc
 286       (lambda (file)
 287         (condition-case alpha
 288             (unless (member file cus-test-libs-noloads)
 289               (load (file-name-sans-extension (expand-file-name file lispdir)))
 290               (push file cus-test-libs-loaded))
 291           (error
 292            (push (cons file alpha) cus-test-libs-errors)
 293            (message "Error for %s: %s" file alpha))))
 294       (cus-test-get-autoload-deps)))))
 295
 296 (defun cus-test-get-autoload-deps ()
 297   "Return the list of files with autoloads."
 298   (with-temp-buffer
 299     (insert-file-contents (locate-library "loaddefs"))
 300     (let (files)
 301       (while (search-forward "\n;;; Generated autoloads from " nil t)
 302         (push (buffer-substring (match-end 0) (line-end-position)) files))
 303       files)))
 304
 305 (defun cus-test-message (list)
 306   "Print the members of LIST line by line."
 307   (dolist (m list) (message "%s" m)))
 308
 309 \f
 310 ;;; The routines for batch mode:
 311
 312 (defun cus-test-opts ()
 313   "Test custom options.
 314 This function is suitable for batch mode.  E.g., invoke
 315
 316   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
 317
 318 in the Emacs source directory."
 319   (interactive)
 320   (message "Running %s" 'cus-test-load-libs)
 321   (cus-test-load-libs)
 322   (message "Running %s" 'cus-test-load-custom-loads)
 323   (cus-test-load-custom-loads)
 324   (message "Running %s" 'cus-test-apropos)
 325   (cus-test-apropos "")
 326   (if (not cus-test-errors)
 327       (message "No problems found")
 328     (message "The following options might have problems:")
 329     (cus-test-message cus-test-errors)))
 330
 331 (defun cus-test-deps ()
 332   "Run a verbose version of `custom-load-symbol' on all atoms.
 333 This function is suitable for batch mode.  E.g., invoke
 334
 335   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
 336
 337 in the Emacs source directory."
 338   (interactive)
 339   (setq cus-test-deps-errors nil)
 340   (setq cus-test-deps-required nil)
 341   (setq cus-test-deps-loaded nil)
 342   (mapatoms
 343    ;; This code is mainly from `custom-load-symbol'.
 344    (lambda (symbol)
 345      (let ((custom-load-recursion t))
 346        (dolist (load (get symbol 'custom-loads))
 347          (cond
 348           ((symbolp load)
 349            ;; (condition-case nil (require load) (error nil))
 350            (condition-case alpha
 351                (unless (or (featurep load)
 352                            (and noninteractive (eq load 'dunnet)))
 353                  (require load)
 354                  (push (list symbol load) cus-test-deps-required))
 355              (error
 356               (push (list symbol load alpha) cus-test-deps-errors)
 357               (message "Require problem: %s %s %s" symbol load alpha))))
 358           ((equal load "loaddefs")
 359            (push
 360             (message "Symbol %s has loaddefs as custom dependency" symbol)
 361             cus-test-deps-errors))
 362           ;; This is subsumed by the test below, but it's much
 363           ;; faster.
 364           ((assoc load load-history))
 365           ;; This was just
 366           ;; (assoc (locate-library load) load-history)
 367           ;; but has been optimized not to load locate-library
 368           ;; if not necessary.
 369           ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
 370                                  "\\(\\'\\|\\.\\)"))
 371                  (found nil))
 372              (dolist (loaded load-history)
 373                (and (stringp (car loaded))
 374                     (string-match regexp (car loaded))
 375                     (setq found t)))
 376              found))
 377           ;; Without this, we would load cus-edit recursively.
 378           ;; We are still loading it when we call this,
 379           ;; and it is not in load-history yet.
 380           ((equal load "cus-edit"))
 381           ;; This would ignore load problems with files in
 382           ;; lisp/term/
 383           ;; ((locate-library (concat term-file-prefix load)))
 384           (t
 385            ;; (condition-case nil (load load) (error nil))
 386            (condition-case alpha
 387                (progn
 388                  (load load)
 389                  (push (list symbol load) cus-test-deps-loaded))
 390              (error
 391               (push (list symbol load alpha) cus-test-deps-errors)
 392               (message "Load Problem: %s %s %s" symbol load alpha))))
 393           )))))
 394   (message "%s features required"
 395            (length cus-test-deps-required))
 396   (message "%s files loaded"
 397            (length cus-test-deps-loaded))
 398   (if (not cus-test-deps-errors)
 399       (message "No load problems encountered")
 400     (message "The following load problems appeared:")
 401     (cus-test-message cus-test-deps-errors))
 402   (run-hooks 'cus-test-after-load-libs-hook))
 403
 404 (defun cus-test-libs ()
 405   "Load the libraries with autoloads in separate processes.
 406 This function is useful to detect load problems of libraries.
 407 It is suitable for batch mode.  E.g., invoke
 408
 409   ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs
 410
 411 in the Emacs source directory."
 412   (interactive)
 413   (cus-test-load-1
 414    (let ((default-directory source-directory)
 415          (emacs (expand-file-name "src/emacs"))
 416          skipped)
 417      (or (file-executable-p emacs)
 418          (error "No Emacs executable in %ssrc" default-directory))
 419      (mapc
 420       (lambda (file)
 421         (if (member file cus-test-libs-noloads)
 422             (push file skipped)
 423           (condition-case alpha
 424               (let* ((fn (expand-file-name file "lisp/"))
 425                      (elc (concat fn "c"))
 426                      status)
 427                 (if (file-readable-p elc) ; load compiled if present (faster)
 428                     (setq fn elc)
 429                   (or (file-readable-p fn)
 430                       (error "Library %s not found" file)))
 431                 (if (equal 0 (setq status (call-process emacs nil nil nil
 432                                                         "-batch" "-l" fn)))
 433                     (message "%s" file)
 434                   (error "%s" status))
 435                 (push file cus-test-libs-loaded))
 436             (error
 437              (push (cons file alpha) cus-test-libs-errors)
 438              (message "Error for %s: %s" file alpha)))))
 439       (cus-test-get-autoload-deps))
 440      (message "Default directory: %s" default-directory)
 441      (when skipped
 442        (message "The following libraries were skipped:")
 443        (cus-test-message skipped)))))
 444
 445 (defun cus-test-noloads ()
 446   "Find custom options not loaded by `custom-load-symbol'.
 447 Calling this function after `cus-test-load-libs' is not meaningful.
 448 It is suitable for batch mode.  E.g., invoke
 449
 450   src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
 451
 452 in the Emacs source directory."
 453   (interactive)
 454   (let (cus-loaded)
 455
 456     (message "Running %s" 'cus-test-load-custom-loads)
 457     (cus-test-load-custom-loads)
 458     (setq cus-loaded
 459           (cus-test-get-options ""))
 460
 461     (message "Running %s" 'cus-test-load-libs)
 462     (cus-test-load-libs)
 463     (setq cus-test-vars-not-cus-loaded
 464           (cus-test-get-options ""))
 465
 466     (dolist (o cus-loaded)
 467       (setq cus-test-vars-not-cus-loaded
 468             (delete o cus-test-vars-not-cus-loaded)))
 469
 470     (if (not cus-test-vars-not-cus-loaded)
 471         (message "No options not loaded by custom-load-symbol found")
 472       (message "The following options were not loaded by custom-load-symbol:")
 473       (cus-test-message
 474        (sort cus-test-vars-not-cus-loaded 'string<)))))
 475
 476 (provide 'cus-test)
 477
 478 ;;; cus-test.el ends here