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 [all]
  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 [all]
  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 (defvar cus-test-libs-noloads
 103   ;; Loading dunnet in batch mode leads to a Dead end.
 104   ;; blessmail writes a file.
 105   ;; characters cannot be loaded twice ("Category `a' is already defined").
 106   '("play/dunnet.el" "emulation/edt-mapper.el"
 107     "loadup.el" "mail/blessmail.el" "international/characters.el"
 108     "cedet/ede/loaddefs.el" "cedet/semantic/loaddefs.el"
 109     "net/tramp-loaddefs.el")
 110   "List of files not to load by `cus-test-load-libs'.
 111 Names should be as they appear in loaddefs.el.")
 112
 113 ;; This avoids a hang of `cus-test-apropos' in 21.2.
 114 ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
 115
 116 (or noninteractive
 117     ;; Never Viperize.
 118     (setq viper-mode nil))
 119
 120 ;; Don't create a file `save-place-file'.
 121 (eval-after-load "saveplace"
 122   '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
 123
 124 ;; Don't create a file `abbrev-file-name'.
 125 (setq save-abbrevs nil)
 126
 127 ;; Avoid compile logs from adviced functions.
 128 (eval-after-load "bytecomp"
 129   '(setq ad-default-compilation-action 'never))
 130
 131 \f
 132 ;;; Main code:
 133
 134 ;; We want to log all messages.
 135 (setq message-log-max t)
 136
 137 (require 'cus-edit)
 138 (require 'cus-load)
 139
 140 (defvar cus-test-errors nil
 141   "List of problematic variables found by `cus-test-apropos'.")
 142
 143 (defvar cus-test-tested-variables nil
 144   "List of options tested by last call of `cus-test-apropos'.")
 145
 146 ;; I haven't understood this :get stuff.  The symbols with a
 147 ;; custom-get property are stored here.
 148 (defvar cus-test-vars-with-custom-get nil
 149   "Set by `cus-test-apropos' to a list of options with :get property.")
 150
 151 (defvar cus-test-vars-with-changed-state nil
 152   "Set by `cus-test-apropos' to a list of options with state 'changed.")
 153
 154 (defvar cus-test-deps-errors nil
 155   "List of require/load problems found by `cus-test-deps'.")
 156
 157 (defvar cus-test-deps-required nil
 158   "List of dependencies required by `cus-test-deps'.
 159 Only unloaded features will be require'd.")
 160
 161 (defvar cus-test-deps-loaded nil
 162   "List of dependencies loaded by `cus-test-deps'.")
 163
 164 (defvar cus-test-libs-errors nil
 165   "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
 166
 167 (defvar cus-test-libs-loaded nil
 168   "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
 169
 170 (defvar cus-test-vars-not-cus-loaded nil
 171   "A list of options not loaded by `custom-load-symbol'.
 172 Set by `cus-test-noloads'.")
 173
 174 ;; (defvar cus-test-vars-cus-loaded nil
 175 ;;   "A list of options loaded by `custom-load-symbol'.")
 176
 177 (defun cus-test-apropos (regexp)
 178   "Check the options matching REGEXP.
 179 The detected problematic options are stored in `cus-test-errors'."
 180   (interactive "sVariable regexp: ")
 181   (setq cus-test-errors nil)
 182   (setq cus-test-tested-variables nil)
 183   (mapc
 184    (lambda (symbol)
 185      (push symbol cus-test-tested-variables)
 186      ;; Be verbose in case we hang.
 187      (message "Cus Test running...%s %s"
 188               (length cus-test-tested-variables) symbol)
 189      (condition-case alpha
 190          (let* ((type (custom-variable-type symbol))
 191                 (conv (widget-convert type))
 192                 (get (or (get symbol 'custom-get) 'default-value))
 193                 values
 194                 mismatch)
 195            (when (default-boundp symbol)
 196              (push (funcall get symbol) values)
 197              (push (eval (car (get symbol 'standard-value))) values))
 198            (if (boundp symbol)
 199                (push (symbol-value symbol) values))
 200            ;; That does not work.
 201            ;; (push (widget-get conv :value) values)
 202
 203            ;; Check the values
 204            (mapc (lambda (value)
 205                    ;; TODO for booleans, check for values that can be
 206                    ;; evaluated and are not t or nil.  Usually a bug.
 207                    (unless (widget-apply conv :match value)
 208                      (setq mismatch 'mismatch)))
 209                  values)
 210
 211            ;; Store symbols with a custom-get property.
 212            (when (get symbol 'custom-get)
 213              (add-to-list 'cus-test-vars-with-custom-get symbol))
 214
 215            ;; Changed outside the customize buffer?
 216            ;; This routine is not very much tested.
 217            (let ((c-value
 218                   (or (get symbol 'customized-value)
 219                       (get symbol 'saved-value)
 220                       (get symbol 'standard-value))))
 221              (and (consp c-value)
 222                   (boundp symbol)
 223                   (not (equal (eval (car c-value)) (symbol-value symbol)))
 224                   (add-to-list 'cus-test-vars-with-changed-state symbol)))
 225
 226            (if mismatch
 227                (push symbol cus-test-errors)))
 228
 229        (error
 230         (push symbol cus-test-errors)
 231         (message "Error for %s: %s" symbol alpha))))
 232    (cus-test-get-options regexp))
 233   (message "%s options tested"
 234            (length cus-test-tested-variables))
 235   (cus-test-errors-display))
 236
 237 (defun cus-test-cus-load-groups (&optional cus-load)
 238   "Return a list of current custom groups.
 239 If CUS-LOAD is non-nil, include groups from cus-load.el."
 240   (append (mapcar 'cdr custom-current-group-alist)
 241           (if cus-load
 242               (with-temp-buffer
 243                 (insert-file-contents (locate-library "cus-load.el"))
 244                 (search-forward "(put '")
 245                 (beginning-of-line)
 246                 (let (res)
 247                   (while (and (looking-at "^(put '\\(\\S-+\\)")
 248                               (zerop (forward-line 1)))
 249                     (push (intern (match-string 1)) res))
 250                   res)))))
 251
 252 (defun cus-test-get-options (regexp &optional group)
 253   "Return a list of custom options matching REGEXP.
 254 If GROUP is non-nil, return groups rather than options.
 255 If GROUP is `cus-load', include groups listed in cus-loads as well as
 256 currently defined groups."
 257   (let ((groups (if group (cus-test-cus-load-groups (eq group 'cus-load))))
 258         found)
 259     (mapatoms
 260      (lambda (symbol)
 261        (and
 262         (if group
 263             (memq symbol groups)
 264           (or
 265            ;; (user-variable-p symbol)
 266            (get symbol 'standard-value)
 267            ;; (get symbol 'saved-value)
 268            (get symbol 'custom-type)))
 269         (string-match regexp (symbol-name symbol))
 270         (not (member symbol cus-test-skip-list))
 271         (push symbol found))))
 272     found))
 273
 274 (defun cus-test-errors-display ()
 275   "Report about the errors found by cus-test."
 276   (with-output-to-temp-buffer "*cus-test-errors*"
 277     (set-buffer standard-output)
 278     (insert (format "Cus Test tested %s variables.\
 279   See `cus-test-tested-variables'.\n\n"
 280                     (length cus-test-tested-variables)))
 281     (if (not cus-test-errors)
 282         (insert "No errors found by cus-test.")
 283       (insert "The following variables seem to have problems:\n\n")
 284       (dolist (e cus-test-errors)
 285         (insert (symbol-name e) "\n")))))
 286
 287 (defun cus-test-load-custom-loads ()
 288   "Call `custom-load-symbol' on all atoms."
 289   (interactive)
 290   (if noninteractive (let (noninteractive) (require 'dunnet)))
 291   (mapatoms 'custom-load-symbol)
 292   (run-hooks 'cus-test-after-load-libs-hook))
 293
 294 (defmacro cus-test-load-1 (&rest body)
 295   `(progn
 296      (setq cus-test-libs-errors nil
 297            cus-test-libs-loaded nil)
 298      ,@body
 299      (message "%s libraries loaded successfully"
 300               (length cus-test-libs-loaded))
 301      (if (not cus-test-libs-errors)
 302          (message "No load problems encountered")
 303        (message "The following load problems appeared:")
 304        (cus-test-message cus-test-libs-errors))
 305      (run-hooks 'cus-test-after-load-libs-hook)))
 306
 307 ;; This is just cus-test-libs, but loading in the current Emacs process.
 308 (defun cus-test-load-libs (&optional more)
 309   "Load the libraries with autoloads.
 310 Don't load libraries in `cus-test-libs-noloads'.
 311 If optional argument MORE is \"defcustom\", load all files with defcustoms.
 312 If it is \"all\", load all Lisp files."
 313   (interactive)
 314   (cus-test-load-1
 315    (let ((lispdir (file-name-directory (locate-library "loaddefs"))))
 316      (mapc
 317       (lambda (file)
 318         (condition-case alpha
 319             (unless (member file cus-test-libs-noloads)
 320               (load (file-name-sans-extension (expand-file-name file lispdir)))
 321               (push file cus-test-libs-loaded))
 322           (error
 323            (push (cons file alpha) cus-test-libs-errors)
 324            (message "Error for %s: %s" file alpha))))
 325       (if more
 326           (cus-test-get-lisp-files (equal more "all"))
 327         (cus-test-get-autoload-deps))))))
 328
 329 (defun cus-test-get-autoload-deps ()
 330   "Return the list of files with autoloads."
 331   (with-temp-buffer
 332     (insert-file-contents (locate-library "loaddefs"))
 333     (let (files)
 334       (while (search-forward "\n;;; Generated autoloads from " nil t)
 335         (push (buffer-substring (match-end 0) (line-end-position)) files))
 336       files)))
 337
 338 (defun cus-test-get-lisp-files (&optional all)
 339   "Return list of all Lisp files with defcustoms.
 340 Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
 341   (let ((default-directory (expand-file-name "lisp/" source-directory))
 342         (msg "Finding files..."))
 343     (message "%s" msg)
 344     (prog1
 345         ;; Hack to remove leading "./".
 346         (mapcar (lambda (e) (substring e 2))
 347                 (apply 'process-lines find-program
 348                        "-name" "obsolete" "-prune" "-o"
 349                        "-name" "[^.]*.el" ; ignore .dir-locals.el
 350                        (if all
 351                            '("-print")
 352                          (list "-exec" grep-program
 353                                "-l" "^[ \t]*(defcustom" "{}" "+"))))
 354       (message "%sdone" msg))))
 355
 356 (defun cus-test-message (list)
 357   "Print the members of LIST line by line."
 358   (dolist (m list) (message "%s" m)))
 359
 360 \f
 361 ;;; The routines for batch mode:
 362
 363 (defun cus-test-opts (&optional all)
 364   "Test custom options.
 365 This function is suitable for batch mode.  E.g., invoke
 366
 367   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
 368
 369 in the Emacs source directory.
 370 Normally only tests options belonging to files in loaddefs.el.
 371 If optional argument ALL is non-nil, test all files with defcustoms."
 372   (interactive)
 373   (and noninteractive
 374        command-line-args-left
 375        (setq all (pop command-line-args-left)))
 376   (message "Running %s" 'cus-test-load-libs)
 377   (cus-test-load-libs (if all "defcustom"))
 378   (message "Running %s" 'cus-test-load-custom-loads)
 379   (cus-test-load-custom-loads)
 380   (message "Running %s" 'cus-test-apropos)
 381   (cus-test-apropos "")
 382   (if (not cus-test-errors)
 383       (message "No problems found")
 384     (message "The following options might have problems:")
 385     (cus-test-message cus-test-errors)))
 386
 387 (defun cus-test-deps ()
 388   "Run a verbose version of `custom-load-symbol' on all atoms.
 389 This function is suitable for batch mode.  E.g., invoke
 390
 391   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
 392
 393 in the Emacs source directory."
 394   (interactive)
 395   (setq cus-test-deps-errors nil)
 396   (setq cus-test-deps-required nil)
 397   (setq cus-test-deps-loaded nil)
 398   (mapatoms
 399    ;; This code is mainly from `custom-load-symbol'.
 400    (lambda (symbol)
 401      (let ((custom-load-recursion t))
 402        (dolist (load (get symbol 'custom-loads))
 403          (cond
 404           ((symbolp load)
 405            ;; (condition-case nil (require load) (error nil))
 406            (condition-case alpha
 407                (unless (or (featurep load)
 408                            (and noninteractive (eq load 'dunnet)))
 409                  (require load)
 410                  (push (list symbol load) cus-test-deps-required))
 411              (error
 412               (push (list symbol load alpha) cus-test-deps-errors)
 413               (message "Require problem: %s %s %s" symbol load alpha))))
 414           ((equal load "loaddefs")
 415            (push
 416             (message "Symbol %s has loaddefs as custom dependency" symbol)
 417             cus-test-deps-errors))
 418           ;; This is subsumed by the test below, but it's much
 419           ;; faster.
 420           ((assoc load load-history))
 421           ;; This was just
 422           ;; (assoc (locate-library load) load-history)
 423           ;; but has been optimized not to load locate-library
 424           ;; if not necessary.
 425           ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
 426                                  "\\(\\'\\|\\.\\)"))
 427                  (found nil))
 428              (dolist (loaded load-history)
 429                (and (stringp (car loaded))
 430                     (string-match regexp (car loaded))
 431                     (setq found t)))
 432              found))
 433           ;; Without this, we would load cus-edit recursively.
 434           ;; We are still loading it when we call this,
 435           ;; and it is not in load-history yet.
 436           ((equal load "cus-edit"))
 437           ;; This would ignore load problems with files in
 438           ;; lisp/term/
 439           ;; ((locate-library (concat term-file-prefix load)))
 440           (t
 441            ;; (condition-case nil (load load) (error nil))
 442            (condition-case alpha
 443                (progn
 444                  (load load)
 445                  (push (list symbol load) cus-test-deps-loaded))
 446              (error
 447               (push (list symbol load alpha) cus-test-deps-errors)
 448               (message "Load Problem: %s %s %s" symbol load alpha))))
 449           )))))
 450   (message "%s features required"
 451            (length cus-test-deps-required))
 452   (message "%s files loaded"
 453            (length cus-test-deps-loaded))
 454   (if (not cus-test-deps-errors)
 455       (message "No load problems encountered")
 456     (message "The following load problems appeared:")
 457     (cus-test-message cus-test-deps-errors))
 458   (run-hooks 'cus-test-after-load-libs-hook))
 459
 460 (defun cus-test-libs (&optional more)
 461   "Load the libraries with autoloads in separate processes.
 462 This function is useful to detect load problems of libraries.
 463 It is suitable for batch mode.  E.g., invoke
 464
 465   ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs
 466
 467 in the Emacs source directory.
 468
 469 If optional argument MORE is \"defcustom\", load all files with defcustoms.
 470 If it is \"all\", load all Lisp files."
 471   (interactive)
 472   (and noninteractive
 473        command-line-args-left
 474        (setq more (pop command-line-args-left)))
 475   (cus-test-load-1
 476    (let* ((default-directory source-directory)
 477           (emacs (expand-file-name "src/emacs"))
 478           skipped)
 479      (or (file-executable-p emacs)
 480          (error "No such executable `%s'" emacs))
 481      (mapc
 482       (lambda (file)
 483         (if (member file cus-test-libs-noloads)
 484             (push file skipped)
 485           (condition-case alpha
 486               (let* ((fn (expand-file-name file "lisp/"))
 487                      (elc (concat fn "c"))
 488                      status)
 489                 (if (file-readable-p elc) ; load compiled if present (faster)
 490                     (setq fn elc)
 491                   (or (file-readable-p fn)
 492                       (error "Library %s not found" file)))
 493                 (if (equal 0 (setq status (call-process emacs nil nil nil
 494                                                         "-batch" "-l" fn)))
 495                     (message "%s" file)
 496                   (error "%s" status))
 497                 (push file cus-test-libs-loaded))
 498             (error
 499              (push (cons file alpha) cus-test-libs-errors)
 500              (message "Error for %s: %s" file alpha)))))
 501       (if more
 502           (cus-test-get-lisp-files (equal more "all"))
 503         (cus-test-get-autoload-deps)))
 504      (message "Default directory: %s" default-directory)
 505      (when skipped
 506        (message "The following libraries were skipped:")
 507        (cus-test-message skipped)))))
 508
 509 (defun cus-test-noloads ()
 510   "Find custom options not loaded by `custom-load-symbol'.
 511 Calling this function after `cus-test-load-libs' is not meaningful.
 512 It is suitable for batch mode.  E.g., invoke
 513
 514   src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
 515
 516 in the Emacs source directory."
 517   (interactive)
 518   (let ((groups-loaded (cus-test-get-options "" 'cus-load))
 519         cus-loaded groups-not-loaded)
 520
 521     (message "Running %s" 'cus-test-load-custom-loads)
 522     (cus-test-load-custom-loads)
 523     (setq cus-loaded (cus-test-get-options ""))
 524
 525     (message "Running %s" 'cus-test-load-libs)
 526     (cus-test-load-libs "all")
 527     (setq cus-test-vars-not-cus-loaded (cus-test-get-options "")
 528           groups-not-loaded (cus-test-get-options "" t))
 529
 530     (dolist (o cus-loaded)
 531       (setq cus-test-vars-not-cus-loaded
 532             (delete o cus-test-vars-not-cus-loaded)))
 533
 534     (if (not cus-test-vars-not-cus-loaded)
 535         (message "No options not loaded by custom-load-symbol found")
 536       (message "The following options were not loaded by custom-load-symbol:")
 537       (cus-test-message
 538        (sort cus-test-vars-not-cus-loaded 'string<)))
 539
 540     (dolist (o groups-loaded)
 541       (setq groups-not-loaded (delete o groups-not-loaded)))
 542
 543     (if (not groups-not-loaded)
 544         (message "No groups not in cus-load.el found")
 545       (message "The following groups are not in cus-load.el:")
 546       (cus-test-message (sort groups-not-loaded 'string<)))))
 547
 548 (provide 'cus-test)
 549
 550 ;;; cus-test.el ends here