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

   1 ;;; cus-test.el --- functions for testing custom variable definitions
   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 ;; Some user options in GNU Emacs have been defined with incorrect
  30 ;; customization types.  As a result the customization of these
  31 ;; options is disabled.  This file provides functions to detect such
  32 ;; options.  It contains also simple tests for loading libraries and
  33 ;; custom dependencies.
  34 ;;
  35 ;; Usage: Load this file.  Then
  36 ;;
  37 ;;    M-x cus-test-apropos REGEXP RET
  38 ;;
  39 ;; checks the options matching REGEXP.  In particular
  40 ;;
  41 ;;    M-x cus-test-apropos RET
  42 ;;
  43 ;; checks all options.  The detected options are stored in the
  44 ;; variable `cus-test-errors'.
  45 ;;
  46 ;; Only those options are checked which have been already loaded.
  47 ;; Therefore `cus-test-apropos' is more efficient after loading many
  48 ;; libraries.
  49 ;;
  50 ;;    M-x cus-test-load-custom-loads RET
  51 ;;
  52 ;; loads all (!) custom dependencies.
  53 ;;
  54 ;; Options with a custom-get property, usually defined by a :get
  55 ;; declaration, are stored in the variable
  56 ;;
  57 ;; `cus-test-vars-with-custom-get'
  58 ;;
  59 ;; Options with a state of 'changed ("changed outside the customize
  60 ;; buffer") are stored in the variable
  61 ;;
  62 ;; `cus-test-vars-with-changed-state'
  63 ;;
  64 ;; These lists are prepared just in case one wants to investigate
  65 ;; those options further.
  66 ;;
  67 ;; For a maximal test of custom options invoke
  68 ;;
  69 ;;    M-x cus-test-opts
  70 ;;
  71 ;; Other test routines are `cus-test-deps' and `cus-test-libs'.
  72 ;; These functions are suitable for batch mode.  Invoke them with
  73 ;;
  74 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
  75 ;;
  76 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
  77 ;;
  78 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-libs
  79 ;;
  80 ;; in the emacs source directory.
  81 ;;
  82 ;; To make cus-test work one has usually to work-around some existing
  83 ;; bugs/problems.  Therefore this file contains "Fixme" and
  84 ;; "Workarounds" sections, to be edited once in a while.
  85 ;;
  86 ;; Results from Oct 10, 2002:
  87 ;;
  88 ;; Cus Test tested 4514 options.
  89 ;; The following variables might have problems:
  90 ;; (ps-mule-font-info-database-default)
  91
  92 ;; Cus Test Deps loaded 332 files.
  93 ;; The following load problems appeared:
  94 ;; ((killing x-win (file-error Cannot open load file x-win)))
  95
  96 ;; Cus Test Libs loaded 424 files.
  97 ;; No load problems encountered by Cus Test Libs
  98
  99 ;;; Code:
 100
 101 ;;; Variables for workarounds:
 102
 103 (defvar cus-test-after-load-libs-hook nil
 104   "Hook to repair the worst side effects of loading buggy libraries.")
 105
 106 (defvar cus-test-libs-noloads nil
 107   "List of libraries not to load by `cus-test-libs'.")
 108
 109 ;;; Fixme:
 110
 111 ;; Loading filesets.el currently disables mini-buffer echoes.
 112 ;; (add-to-list 'cus-test-libs-noloads "filesets")
 113 (add-hook
 114  'cus-test-after-load-libs-hook
 115  (lambda nil
 116    (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe)
 117    (remove-hook 'kill-emacs-hook 'filesets-exit)
 118    (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl)
 119    (remove-hook 'first-change-hook 'filesets-reset-filename-on-change)
 120    ))
 121 ;; (setq cus-test-after-load-libs-hook nil)
 122
 123 ;; eshell must be loaded before em-script.  eshell loads esh-util,
 124 ;; which must be loaded before em-cmpl, em-dirs and similar libraries.
 125 (load "eshell")
 126
 127 ;; reftex must be loaded before reftex-vars.
 128 (load "reftex")
 129
 130 ;;; Workarounds:
 131
 132 ;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which
 133 ;; are not part of GNU Emacs:  (locate-library "bbdb") => nil
 134
 135 ;; This avoids the resulting errors from loading eudc-export.el.
 136 (provide 'bbdb)
 137 (provide 'bbdb-com)
 138
 139 ;; Loading dunnet in batch mode leads to a Dead end.
 140 (let (noninteractive)
 141   (load "dunnet"))
 142 (add-to-list 'cus-test-libs-noloads "dunnet")
 143
 144 ;;; Silencing:
 145
 146 ;; Don't create a file `filesets-menu-cache-file'.
 147 (setq filesets-menu-cache-file "")
 148
 149 ;; Don't create a file `save-place-file'.
 150 (eval-after-load "saveplace"
 151   '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
 152
 153 ;; Don't create a file `abbrev-file-name'.
 154 (setq save-abbrevs nil)
 155
 156 ;; Avoid compile logs from adviced functions.
 157 (eval-after-load "bytecomp"
 158   '(setq ad-default-compilation-action 'never))
 159
 160 ;; We want to log all messages.
 161 (setq message-log-max t)
 162
 163 \f
 164 ;;; Main Code:
 165
 166 (require 'cus-edit)
 167 (require 'cus-load)
 168
 169 (defvar cus-test-tested-variables nil
 170   "Options tested by last call of `cus-test-apropos'.")
 171
 172 (defvar cus-test-errors nil
 173   "List of problematic variables found by `cus-test-apropos'.")
 174
 175 (defvar cus-test-deps-errors nil
 176   "List of require/load problems found by `cus-test-deps'.")
 177
 178 (defvar cus-test-deps-tested nil
 179   "Dependencies loaded by `cus-test-deps'.")
 180
 181 (defvar cus-test-libs-errors nil
 182   "List of load problems found by `cus-test-libs'.")
 183
 184 (defvar cus-test-libs-loaded nil
 185   "Files loaded by `cus-test-libs'.")
 186
 187 ;; I haven't understood this :get stuff.  However, there are only very
 188 ;; few variables with a custom-get property.  Such symbols are stored
 189 ;; in `cus-test-vars-with-custom-get'.
 190 (defvar cus-test-vars-with-custom-get nil
 191   "Set by `cus-test-apropos' to a list of options with :get property.")
 192
 193 (defvar cus-test-vars-with-changed-state nil
 194   "Set by `cus-test-apropos' to a list of options with state 'changed.")
 195
 196 (defun cus-test-apropos (regexp)
 197   "Check the options matching REGEXP.
 198 The detected problematic options are stored in `cus-test-errors'."
 199   (interactive "sVariable regexp: ")
 200   (setq cus-test-errors nil)
 201   (setq cus-test-tested-variables nil)
 202   (mapcar
 203    (lambda (symbol)
 204      (push symbol cus-test-tested-variables)
 205      (unless noninteractive
 206        (message "Cus Test Running...[%s]"
 207                 (length cus-test-tested-variables)))
 208      (condition-case alpha
 209          (let* ((type (custom-variable-type symbol))
 210                 (conv (widget-convert type))
 211                 (get (or (get symbol 'custom-get) 'default-value))
 212                 values
 213                 mismatch)
 214            (when (default-boundp symbol)
 215              (push (funcall get symbol) values)
 216              (push (eval (car (get symbol 'standard-value))) values))
 217            (if (boundp symbol)
 218                (push (symbol-value symbol) values))
 219            ;; That does not work.
 220            ;; (push (widget-get conv :value) values)
 221
 222            ;; Check the values
 223            (mapcar (lambda (value)
 224                      (unless (widget-apply conv :match value)
 225                        (setq mismatch 'mismatch)))
 226                    values)
 227
 228            ;; Store symbols with a custom-get property.
 229            (when (get symbol 'custom-get)
 230              (push symbol cus-test-vars-with-custom-get))
 231
 232            ;; Changed outside the customize buffer?
 233            ;; This routine is not very much tested.
 234            (let ((c-value
 235                   (or (get symbol 'customized-value)
 236                       (get symbol 'saved-value)
 237                       (get symbol 'standard-value))))
 238              (and (consp c-value)
 239                   (boundp symbol)
 240                   (not (equal (eval (car c-value)) (symbol-value symbol)))
 241                   (push symbol cus-test-vars-with-changed-state)))
 242
 243            (if mismatch
 244                (push symbol cus-test-errors)))
 245
 246        (error
 247         (push symbol cus-test-errors)
 248         (message "Error for %s: %s" symbol alpha))))
 249    (cus-test-get-options regexp))
 250   (message "Cus Test tested %s options."
 251            (length cus-test-tested-variables))
 252   (cus-test-errors-display))
 253
 254 (defun cus-test-get-options (regexp)
 255   "Return a list of custom options matching REGEXP."
 256   (let (found)
 257     (mapatoms
 258      (lambda (symbol)
 259        (and
 260         (or
 261          ;; (user-variable-p symbol)
 262          (get symbol 'standard-value)
 263          ;; (get symbol 'saved-value)
 264          (get symbol 'custom-type))
 265         (string-match regexp (symbol-name symbol))
 266         ;;      (not (member symbol cus-test-strange-vars))
 267         (push symbol found))))
 268     found))
 269
 270 (defun cus-test-errors-display ()
 271   "Report about the errors found by cus-test."
 272   (with-output-to-temp-buffer "*cus-test-errors*"
 273     (set-buffer standard-output)
 274     (insert (format "Cus Test tested %s variables.\
 275   See `cus-test-tested-variables'.\n\n"
 276                     (length cus-test-tested-variables)))
 277     (if cus-test-errors
 278         (let ((L cus-test-errors))
 279           (insert "The following variables seem to have errors:\n\n")
 280           (while L (insert (symbol-name (car L))) (insert "\n")
 281                  (setq L (cdr L))))
 282       (insert "No errors found by cus-test."))))
 283
 284 (defun cus-test-load-custom-loads nil
 285   "Call `custom-load-symbol' on all atoms."
 286   (interactive)
 287   (mapatoms 'custom-load-symbol)
 288   (run-hooks 'cus-test-after-load-libs-hook))
 289
 290 ;;; The routines for batch mode:
 291
 292 (defun cus-test-opts nil
 293   "Test custom options.
 294 This function is suitable for batch mode.  E.g., invoke
 295
 296   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
 297
 298 in the emacs source directory."
 299   (interactive)
 300   (message "Running %s" 'cus-test-load-custom-loads)
 301   (cus-test-load-custom-loads)
 302   (message "Running %s" 'cus-test-apropos)
 303   (cus-test-apropos "")
 304   (if cus-test-errors
 305       (message "The following options might have problems:\n%s"
 306                cus-test-errors)
 307     (message "No problems found by Cus Test Opts")))
 308
 309 (defun cus-test-deps nil
 310   "Run a verbose version of `custom-load-symbol' on all atoms.
 311 This function is suitable for batch mode.  E.g., invoke
 312
 313   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
 314
 315 in the emacs source directory."
 316   (interactive)
 317   (setq cus-test-deps-errors nil)
 318   (setq cus-test-deps-tested nil)
 319   (mapatoms
 320    ;; This code is mainly from `custom-load-symbol'.
 321    (lambda (symbol)
 322      (unless custom-load-recursion
 323        (let ((custom-load-recursion t))
 324          (dolist (load (get symbol 'custom-loads))
 325            (cond
 326             ((symbolp load)
 327              ;; (condition-case nil (require load) (error nil))
 328              (condition-case alpha
 329                  (require load)
 330                (error
 331                 (push (list symbol load alpha) cus-test-deps-errors)
 332                 (message "Require problem: %s %s: %s" symbol load alpha)))
 333              (push (list symbol load) cus-test-deps-tested))
 334             ;; This is subsumed by the test below, but it's much
 335             ;; faster.
 336             ((assoc load load-history))
 337             ;; This was just
 338             ;; (assoc (locate-library load) load-history)
 339             ;; but has been optimized not to load locate-library
 340             ;; if not necessary.
 341             ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
 342                                    "\\(\\'\\|\\.\\)"))
 343                    (found nil))
 344                (dolist (loaded load-history)
 345                  (and (stringp (car loaded))
 346                       (string-match regexp (car loaded))
 347                       (setq found t)))
 348                found))
 349             ;; Without this, we would load cus-edit recursively.
 350             ;; We are still loading it when we call this,
 351             ;; and it is not in load-history yet.
 352             ((equal load "cus-edit"))
 353             (t
 354              ;; (condition-case nil (load load) (error nil))
 355              (condition-case alpha
 356                  (load load)
 357                (error
 358                 (push (list symbol load alpha) cus-test-deps-errors)
 359                 (message "Load Problem: %s %s: %s" symbol load alpha)))
 360              (push (list symbol load) cus-test-deps-tested))
 361             ))))))
 362   (message "Cus Test Deps loaded %s files."
 363            (length cus-test-deps-tested))
 364   (if cus-test-deps-errors
 365       (message "The following load problems appeared:\n%s"
 366                cus-test-deps-errors)
 367     (message "No load problems encountered by Cus Test Deps"))
 368   (run-hooks 'cus-test-after-load-libs-hook))
 369
 370 (defun cus-test-libs ()
 371   "Load the libraries with autoloads in loaddefs.el.
 372 Don't load libraries in `cus-test-libs-noloads'.
 373
 374 This function is useful to detect load problems of libraries.
 375 It is suitable for batch mode.  E.g., invoke
 376
 377   src/emacs -batch -l admin/cus-test.el -f cus-test-libs
 378
 379 in the emacs source directory."
 380   (interactive)
 381   (setq cus-test-libs-errors nil)
 382   (setq cus-test-libs-loaded nil)
 383   (set-buffer (find-file-noselect (locate-library "loaddefs")))
 384   (goto-char (point-min))
 385   (let (file)
 386     (while
 387         (search-forward "\n;;; Generated autoloads from " nil t)
 388       (goto-char (match-end 0))
 389       (setq file (buffer-substring (point)
 390                                    (progn (end-of-line) (point))))
 391       ;; If it is, load that library.
 392       (when file
 393         (setq file (file-name-nondirectory file))
 394         (when (string-match "\\.el\\'" file)
 395           (setq file (substring file 0 (match-beginning 0)))))
 396       (condition-case alpha
 397           (unless (member file cus-test-libs-noloads)
 398             (load-library file)
 399             (push file cus-test-libs-loaded))
 400         (error
 401          (push (cons file alpha) cus-test-libs-errors)
 402          (message "Error for %s: %s" file alpha)))))
 403   (message "Cus Test Libs loaded %s files."
 404            (length cus-test-libs-loaded))
 405   (if cus-test-libs-errors
 406       (message "The following load problems appeared:\n%s"
 407                cus-test-libs-errors)
 408     (message "No load problems encountered by Cus Test Libs"))
 409   (run-hooks 'cus-test-after-load-libs-hook))
 410
 411 (provide 'cus-test)
 412
 413 ;;; cus-test.el ends here