Minor change.

[gnu-emacs] / admin / cus-test.el

;;; cus-test.el --- tests for custom types and load problems

;; Copyright (C) 1998, 2000, 2002 Free Software Foundation, Inc.

;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
;; Created: 13 Sep 1998
;; Keywords: maint

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file provides simple tests to detect custom options with
;; incorrect customization types and load problems for custom and
;; autoload dependencies.
;;
;; The basic tests can be run in batch mode.  Invoke them with
;;
;;   src/emacs -batch -l admin/cus-test.el -f cus-test-opts
;;
;;   src/emacs -batch -l admin/cus-test.el -f cus-test-deps
;;
;;   src/emacs -batch -l admin/cus-test.el -f cus-test-libs
;;
;; in the emacs source directory.
;;
;; For interactive use: Load this file.  Then
;;
;;    M-x cus-test-apropos REGEXP RET
;;
;; checks the options matching REGEXP.  In particular
;;
;;    M-x cus-test-apropos RET
;;
;; checks all options.  The detected options are stored in the
;; variable `cus-test-errors'.
;;
;; Only those options are checked which have been already loaded.
;; Therefore `cus-test-apropos' is more efficient after loading many
;; libraries.
;;
;;    M-x cus-test-load-custom-loads
;;
;; loads all (!) custom dependencies and
;;
;;    M-x cus-test-load-libs
;;
;; loads all (!) libraries with autoloads.
;;
;; Options with a custom-get property, usually defined by a :get
;; declaration, are stored in the variable
;;
;; `cus-test-vars-with-custom-get'
;;
;; Options with a state of 'changed ("changed outside the customize
;; buffer") are stored in the variable
;;
;; `cus-test-vars-with-changed-state'
;;
;; These lists are prepared just in case one wants to investigate
;; those options further.
;;
;; The command `cus-test-opts' tests many (all?) custom options.
;;
;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
;; but reports about load errors.
;;
;; The command `cus-test-libs' runs for all libraries with autoloads
;; separate emacs processes of the form "emacs -batch -l LIB".
;;
;; Some results from October 2002:
;;
;; 4523 options tested
;; The following variables might have problems:
;; ps-mule-font-info-database-default
;; grep-tree-command
;; grep-find-command
;;
;; 288 features required
;; 10 files loaded
;; The following load problems appeared:
;; (killing x-win (file-error Cannot open load file x-win))
;; Symbol faces has loaddefs as custom dependency
;; (reftex-index-support reftex-vars (void-function reftex-set-dirty))
;; (eshell-script em-script (void-variable eshell-directory-name))
;; (pcomplete em-cmpl (void-function eshell-under-windows-p))
;; (eshell-ext esh-ext (void-function eshell-under-windows-p))
;; ...
;;
;; 422 libraries had no load errors
;; The following load problems appeared:
;; (eudc-export error 255)
;; (ada-xref error 255)
;; (ada-stmt error 255)

;;; Code:

;;; Workarounds.  For a smooth run and to avoid some side effects.

(defvar cus-test-after-load-libs-hook nil
  "Used to switch off undesired side effects of loading libraries.")

(defvar cus-test-skip-list nil
  "List of variables to disregard by `cus-test-apropos'.")

(defvar cus-test-noloads nil
  "List of libraries not to load by `cus-test-load-libs'.")

;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which
;; are not part of GNU Emacs:  (locate-library "bbdb") => nil
;; We avoid the resulting errors from loading eudc-export.el:
(provide 'bbdb)
(provide 'bbdb-com)

;; This avoids a hang of `cus-test-apropos' in 21.2.
;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)

;; Don't create a file `filesets-menu-cache-file'.
(setq filesets-menu-cache-file "")
;; Disable filesets hooks.
(add-hook
 'cus-test-after-load-libs-hook
 (lambda nil
   (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe)
   (remove-hook 'kill-emacs-hook 'filesets-exit)
   (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl)
   (remove-hook 'first-change-hook 'filesets-reset-filename-on-change)
   ))

;; Loading dunnet in batch mode leads to a Dead end.
(let (noninteractive) (load "dunnet"))
(add-to-list 'cus-test-noloads "dunnet")

;; Never Viperize.
(setq viper-mode nil)

;; Don't create a file `save-place-file'.
(eval-after-load "saveplace"
  '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))

;; Don't create a file `abbrev-file-name'.
(setq save-abbrevs nil)

;; Avoid compile logs from adviced functions.
(eval-after-load "bytecomp"
  '(setq ad-default-compilation-action 'never))

\f
;;; Main code:

;; We want to log all messages.
(setq message-log-max t)

(require 'cus-edit)
(require 'cus-load)

(defvar cus-test-errors nil
  "List of problematic variables found by `cus-test-apropos'.")

(defvar cus-test-tested-variables nil
  "List of options tested by last call of `cus-test-apropos'.")

(defvar cus-test-deps-errors nil
  "List of require/load problems found by `cus-test-deps'.")

(defvar cus-test-deps-required nil
  "List of dependencies required by `cus-test-deps'.
Only unloaded features will be require'd.")

(defvar cus-test-deps-loaded nil
  "List of dependencies loaded by `cus-test-deps'.")

(defvar cus-test-libs-errors nil
  "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")

(defvar cus-test-libs-loaded nil
  "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")

;; I haven't understood this :get stuff.  The symbols with a
;; custom-get property are stored here.
(defvar cus-test-vars-with-custom-get nil
  "Set by `cus-test-apropos' to a list of options with :get property.")

(defvar cus-test-vars-with-changed-state nil
  "Set by `cus-test-apropos' to a list of options with state 'changed.")

(defun cus-test-apropos (regexp)
  "Check the options matching REGEXP.
The detected problematic options are stored in `cus-test-errors'."
  (interactive "sVariable regexp: ")
  (setq cus-test-errors nil)
  (setq cus-test-tested-variables nil)
  (mapc
   (lambda (symbol)
     (push symbol cus-test-tested-variables)
     ;; Be verbose in case we hang.
     (message "Cus Test running...%s %s"
              (length cus-test-tested-variables) symbol)
     (condition-case alpha
         (let* ((type (custom-variable-type symbol))
                (conv (widget-convert type))
                (get (or (get symbol 'custom-get) 'default-value))
                values
                mismatch)
           (when (default-boundp symbol)
             (push (funcall get symbol) values)
             (push (eval (car (get symbol 'standard-value))) values))
           (if (boundp symbol)
               (push (symbol-value symbol) values))
           ;; That does not work.
           ;; (push (widget-get conv :value) values)

           ;; Check the values
           (mapc (lambda (value)
                   (unless (widget-apply conv :match value)
                     (setq mismatch 'mismatch)))
                 values)

           ;; Store symbols with a custom-get property.
           (when (get symbol 'custom-get)
             (add-to-list 'cus-test-vars-with-custom-get symbol))

           ;; Changed outside the customize buffer?
           ;; This routine is not very much tested.
           (let ((c-value
                  (or (get symbol 'customized-value)
                      (get symbol 'saved-value)
                      (get symbol 'standard-value))))
             (and (consp c-value)
                  (boundp symbol)
                  (not (equal (eval (car c-value)) (symbol-value symbol)))
                  (add-to-list 'cus-test-vars-with-changed-state symbol)))

           (if mismatch
               (push symbol cus-test-errors)))

       (error
        (push symbol cus-test-errors)
        (message "Error for %s: %s" symbol alpha))))
   (cus-test-get-options regexp))
  (message "%s options tested"
           (length cus-test-tested-variables))
  (cus-test-errors-display))

(defun cus-test-get-options (regexp)
  "Return a list of custom options matching REGEXP."
  (let (found)
    (mapatoms
     (lambda (symbol)
       (and
        (or
         ;; (user-variable-p symbol)
         (get symbol 'standard-value)
         ;; (get symbol 'saved-value)
         (get symbol 'custom-type))
        (string-match regexp (symbol-name symbol))
        (not (member symbol cus-test-skip-list))
        (push symbol found))))
    found))

(defun cus-test-errors-display ()
  "Report about the errors found by cus-test."
  (with-output-to-temp-buffer "*cus-test-errors*"
    (set-buffer standard-output)
    (insert (format "Cus Test tested %s variables.\
  See `cus-test-tested-variables'.\n\n"
                    (length cus-test-tested-variables)))
    (if (not cus-test-errors)
        (insert "No errors found by cus-test.")
      (insert "The following variables seem to have problems:\n\n")
      (dolist (E cus-test-errors)
        (insert (symbol-name E) "\n")))))

(defun cus-test-load-custom-loads ()
  "Call `custom-load-symbol' on all atoms."
  (interactive)
  (mapatoms 'custom-load-symbol)
  (run-hooks 'cus-test-after-load-libs-hook))

(defun cus-test-load-libs ()
  "Load the libraries with autoloads.
Don't load libraries in `cus-test-noloads'."
  (interactive)
  (setq cus-test-libs-errors nil)
  (setq cus-test-libs-loaded nil)
  (mapc
   (lambda (file)
     (condition-case alpha
         (unless (member file cus-test-noloads)
           (load file)
           (push file cus-test-libs-loaded))
       (error
        (push (cons file alpha) cus-test-libs-errors)
        (message "Error for %s: %s" file alpha))))
   (cus-test-get-autoload-deps))
  (message "%s libraries loaded successfully"
           (length cus-test-libs-loaded))
  (if (not cus-test-libs-errors)
      (message "No load problems encountered")
    (message "The following load problems appeared:")
    (cus-test-message cus-test-libs-errors))
  (run-hooks 'cus-test-after-load-libs-hook))

(defun cus-test-get-autoload-deps ()
  "Return the list of libraries with autoloads."
  (with-temp-buffer
    (insert-file-contents (locate-library "loaddefs"))
    ;; This is from `customize-option'.
    (let (deps file)
      (while
          (search-forward "\n;;; Generated autoloads from " nil t)
        (goto-char (match-end 0))
        (setq file (buffer-substring (point)
                                     (progn (end-of-line) (point))))
        (setq file (file-name-nondirectory file))
        (string-match "\\.el\\'" file)
        (setq file (substring file 0 (match-beginning 0)))
        (setq deps (nconc deps (list file))))
      deps)))

(defun cus-test-message (list)
  "Print the members of LIST line by line."
  (dolist (m list) (message "%s" m)))

\f
;;; The routines for batch mode:

(defun cus-test-opts ()
  "Test custom options.
This function is suitable for batch mode.  E.g., invoke

  src/emacs -batch -l admin/cus-test.el -f cus-test-opts

in the emacs source directory."
  (interactive)
  (message "Running %s" 'cus-test-load-libs)
  (cus-test-load-libs)
  (message "Running %s" 'cus-test-load-custom-loads)
  (cus-test-load-custom-loads)
  (message "Running %s" 'cus-test-apropos)
  (cus-test-apropos "")
  (if (not cus-test-errors)
      (message "No problems found")
    (message "The following options might have problems:")
    (cus-test-message cus-test-errors)))

(defun cus-test-deps ()
  "Run a verbose version of `custom-load-symbol' on all atoms.
This function is suitable for batch mode.  E.g., invoke

  src/emacs -batch -l admin/cus-test.el -f cus-test-deps

in the emacs source directory."
  (interactive)
  (setq cus-test-deps-errors nil)
  (setq cus-test-deps-required nil)
  (setq cus-test-deps-loaded nil)
  (mapatoms
   ;; This code is mainly from `custom-load-symbol'.
   (lambda (symbol)
     (unless custom-load-recursion
       (let ((custom-load-recursion t))
         (dolist (load (get symbol 'custom-loads))
           (cond
            ((symbolp load)
             ;; (condition-case nil (require load) (error nil))
             (condition-case alpha
                 (unless (featurep load)
                   (require load)
                   (push (list symbol load) cus-test-deps-required))
               (error
                (push (list symbol load alpha) cus-test-deps-errors)
                (message "Require problem: %s %s %s" symbol load alpha))))
            ((equal load "loaddefs")
             (push
              (message "Symbol %s has loaddefs as custom dependency" symbol)
              cus-test-deps-errors))
            ;; This is subsumed by the test below, but it's much
            ;; faster.
            ((assoc load load-history))
            ;; This was just
            ;; (assoc (locate-library load) load-history)
            ;; but has been optimized not to load locate-library
            ;; if not necessary.
            ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
                                   "\\(\\'\\|\\.\\)"))
                   (found nil))
               (dolist (loaded load-history)
                 (and (stringp (car loaded))
                      (string-match regexp (car loaded))
                      (setq found t)))
               found))
            ;; Without this, we would load cus-edit recursively.
            ;; We are still loading it when we call this,
            ;; and it is not in load-history yet.
            ((equal load "cus-edit"))
            ;; This would ignore load problems with files in
            ;; lisp/term/
            ;; ((locate-library (concat term-file-prefix load)))
            (t
             ;; (condition-case nil (load load) (error nil))
             (condition-case alpha
                 (progn
                   (load load)
                   (push (list symbol load) cus-test-deps-loaded))
               (error
                (push (list symbol load alpha) cus-test-deps-errors)
                (message "Load Problem: %s %s %s" symbol load alpha))))
            ))))))
  (message "%s features required"
           (length cus-test-deps-required))
  (message "%s files loaded"
           (length cus-test-deps-loaded))
  (if (not cus-test-deps-errors)
      (message "No load problems encountered")
    (message "The following load problems appeared:")
    (cus-test-message cus-test-deps-errors))
  (run-hooks 'cus-test-after-load-libs-hook))

(defun cus-test-libs ()
  "Load the libraries with autoloads in separate processes.
This function is useful to detect load problems of libraries.
It is suitable for batch mode.  E.g., invoke

  src/emacs -batch -l admin/cus-test.el -f cus-test-libs

in the emacs source directory."
  (interactive)
  (with-temp-buffer
    (setq cus-test-libs-errors nil)
    (setq cus-test-libs-loaded nil)
    (cd source-directory)
    (if (not (file-executable-p "src/emacs"))
        (error "No Emacs executable in %ssrc" default-directory))
    (mapc
     (lambda (file)
       (condition-case alpha
           (let (fn cmd status)
             (setq fn (locate-library file))
             (if (not fn)
                 (error "Library %s not found" file))
             (setq cmd (concat "src/emacs -batch -l " fn))
             (setq status (call-process shell-file-name nil nil nil
                                        shell-command-switch cmd))
             (if (= status 0)
                 (message "%s" file)
               (error "%s" status))
             (push file cus-test-libs-loaded))
         (error
          (push (cons file alpha) cus-test-libs-errors)
          (message "Error for %s: %s" file alpha))))
     (cus-test-get-autoload-deps))
    (message "Default Directory: %s" default-directory)
    (message "%s libraries had no load errors"
             (length cus-test-libs-loaded))
    (if (not cus-test-libs-errors)
        (message "No load problems encountered")
      (message "The following load problems appeared:")
      (cus-test-message cus-test-libs-errors))
    (run-hooks 'cus-test-after-load-libs-hook)))

(provide 'cus-test)

;;; cus-test.el ends here