admin/cus-test.el

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