;;; cus-test.el --- tests for custom types and load problems
-;; Copyright (C) 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2002-2014 Free Software Foundation, Inc.
;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
;;
;; 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-opts [all]
;;
;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps
;;
-;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs
+;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs [all]
;;
;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
;;
;; The command `cus-test-noloads' returns a list of variables which
;; are somewhere declared as custom options, but not loaded by
;; `custom-load-symbol'.
-;;
-;; 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)
-;;
-;; The following options were not loaded by custom-load-symbol:
-;; edt-bottom-scroll-margin
-;; edt-keep-current-page-delimiter
-;; edt-top-scroll-margin
-;; edt-use-EDT-control-key-bindings
-;; edt-word-entities
-;; grep-find-use-xargs
-;; master-mode-hook
-;; outline-level
-;; outline-minor-mode-hook
-;; refill-mode-hook
\f
;;; Code:
(defvar cus-test-skip-list nil
"List of variables to disregard by `cus-test-apropos'.")
-(defvar cus-test-libs-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)
+(defvar cus-test-libs-noloads
+ ;; Loading dunnet in batch mode leads to a Dead end.
+ ;; blessmail writes a file.
+ ;; characters cannot be loaded twice ("Category `a' is already defined").
+ '("play/dunnet.el" "emulation/edt-mapper.el"
+ "loadup.el" "mail/blessmail.el" "international/characters.el"
+ "cedet/ede/loaddefs.el" "cedet/semantic/loaddefs.el"
+ "net/tramp-loaddefs.el")
+ "List of files not to load by `cus-test-load-libs'.
+Names should be as they appear in loaddefs.el.")
;; This avoids a hang of `cus-test-apropos' in 21.2.
;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
-;; Loading dunnet in batch mode leads to a Dead end.
-(let (noninteractive) (load "dunnet"))
-(add-to-list 'cus-test-libs-noloads "dunnet")
-
-;; Never Viperize.
-(setq viper-mode nil)
+(or noninteractive
+ ;; Never Viperize.
+ (setq viper-mode nil))
;; Don't create a file `save-place-file'.
(eval-after-load "saveplace"
(message "Cus Test running...%s %s"
(length cus-test-tested-variables) symbol)
(condition-case alpha
+ ;; FIXME This defaults to 'sexp if no type was specified.
+ ;; Always report such instances as a type mismatch.
+ ;; Currently abusing cusver-scan to do that.
(let* ((type (custom-variable-type symbol))
(conv (widget-convert type))
(get (or (get symbol 'custom-get) 'default-value))
;; Check the values
(mapc (lambda (value)
+ ;; TODO for booleans, check for values that can be
+ ;; evaluated and are not t or nil. Usually a bug.
(unless (widget-apply conv :match value)
(setq mismatch 'mismatch)))
values)
(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)
+(defun cus-test-cus-load-groups (&optional cus-load)
+ "Return a list of current custom groups.
+If CUS-LOAD is non-nil, include groups from cus-load.el."
+ (append (mapcar 'cdr custom-current-group-alist)
+ (if cus-load
+ (with-temp-buffer
+ (insert-file-contents (locate-library "cus-load.el"))
+ (search-forward "(put '")
+ (beginning-of-line)
+ (let (res)
+ (while (and (looking-at "^(put '\\(\\S-+\\)")
+ (zerop (forward-line 1)))
+ (push (intern (match-string 1)) res))
+ res)))))
+
+(defun cus-test-get-options (regexp &optional group)
+ "Return a list of custom options matching REGEXP.
+If GROUP is non-nil, return groups rather than options.
+If GROUP is `cus-load', include groups listed in cus-loads as well as
+currently defined groups."
+ (let ((groups (if group (cus-test-cus-load-groups (eq group 'cus-load))))
+ found)
(mapatoms
(lambda (symbol)
(and
- (or
- ;; (user-variable-p symbol)
- (get symbol 'standard-value)
- ;; (get symbol 'saved-value)
- (get symbol 'custom-type))
+ (if group
+ (memq symbol groups)
+ (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))))
(defun cus-test-load-custom-loads ()
"Call `custom-load-symbol' on all atoms."
(interactive)
+ (if noninteractive (let (noninteractive) (require 'dunnet)))
(mapatoms 'custom-load-symbol)
(run-hooks 'cus-test-after-load-libs-hook))
-(defun cus-test-load-libs ()
+(defmacro cus-test-load-1 (&rest body)
+ `(progn
+ (setq cus-test-libs-errors nil
+ cus-test-libs-loaded nil)
+ ,@body
+ (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)))
+
+;; This is just cus-test-libs, but loading in the current Emacs process.
+(defun cus-test-load-libs (&optional more)
"Load the libraries with autoloads.
-Don't load libraries in `cus-test-libs-noloads'."
+Don't load libraries in `cus-test-libs-noloads'.
+If optional argument MORE is \"defcustom\", load all files with defcustoms.
+If it is \"all\", load all Lisp files."
(interactive)
- (setq cus-test-libs-errors nil)
- (setq cus-test-libs-loaded nil)
- (mapc
- (lambda (file)
- (condition-case alpha
- (unless (member file cus-test-libs-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))
+ (cus-test-load-1
+ (let ((lispdir (file-name-directory (locate-library "loaddefs"))))
+ (mapc
+ (lambda (file)
+ (condition-case alpha
+ (unless (member file cus-test-libs-noloads)
+ (load (file-name-sans-extension (expand-file-name file lispdir)))
+ (push file cus-test-libs-loaded))
+ (error
+ (push (cons file alpha) cus-test-libs-errors)
+ (message "Error for %s: %s" file alpha))))
+ (if more
+ (cus-test-get-lisp-files (equal more "all"))
+ (cus-test-get-autoload-deps))))))
(defun cus-test-get-autoload-deps ()
- "Return the list of libraries with autoloads."
+ "Return the list of files 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)))
+ (let (files)
+ (while (search-forward "\n;;; Generated autoloads from " nil t)
+ (push (buffer-substring (match-end 0) (line-end-position)) files))
+ files)))
+
+(defun cus-test-get-lisp-files (&optional all)
+ "Return list of all Lisp files with defcustoms.
+Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
+ (let ((default-directory (expand-file-name "lisp/" source-directory))
+ (msg "Finding files..."))
+ (message "%s" msg)
+ (prog1
+ ;; Hack to remove leading "./".
+ (mapcar (lambda (e) (substring e 2))
+ (apply 'process-lines find-program
+ "-name" "obsolete" "-prune" "-o"
+ "-name" "[^.]*.el" ; ignore .dir-locals.el
+ (if all
+ '("-print")
+ (list "-exec" grep-program
+ "-l" "^[ \t]*(defcustom" "{}" "+"))))
+ (message "%sdone" msg))))
(defun cus-test-message (list)
"Print the members of LIST line by line."
\f
;;; The routines for batch mode:
-(defun cus-test-opts ()
+(defun cus-test-opts (&optional all)
"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."
+in the Emacs source directory.
+Normally only tests options belonging to files in loaddefs.el.
+If optional argument ALL is non-nil, test all files with defcustoms."
(interactive)
+ (and noninteractive
+ command-line-args-left
+ (setq all (pop command-line-args-left)))
(message "Running %s" 'cus-test-load-libs)
- (cus-test-load-libs)
+ (cus-test-load-libs (if all "defcustom"))
(message "Running %s" 'cus-test-load-custom-loads)
(cus-test-load-custom-loads)
(message "Running %s" 'cus-test-apropos)
((symbolp load)
;; (condition-case nil (require load) (error nil))
(condition-case alpha
- (unless (featurep load)
+ (unless (or (featurep load)
+ (and noninteractive (eq load 'dunnet)))
(require load)
(push (list symbol load) cus-test-deps-required))
(error
(cus-test-message cus-test-deps-errors))
(run-hooks 'cus-test-after-load-libs-hook))
-(defun cus-test-libs ()
+(defun cus-test-libs (&optional more)
"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
+ ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs
-in the Emacs source directory."
+in the Emacs source directory.
+
+If optional argument MORE is \"defcustom\", load all files with defcustoms.
+If it is \"all\", load all Lisp files."
(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 (equal 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)))
+ (and noninteractive
+ command-line-args-left
+ (setq more (pop command-line-args-left)))
+ (cus-test-load-1
+ (let* ((default-directory source-directory)
+ (emacs (expand-file-name "src/emacs"))
+ skipped)
+ (or (file-executable-p emacs)
+ (error "No such executable `%s'" emacs))
+ (mapc
+ (lambda (file)
+ (if (member file cus-test-libs-noloads)
+ (push file skipped)
+ (condition-case alpha
+ (let* ((fn (expand-file-name file "lisp/"))
+ (elc (concat fn "c"))
+ status)
+ (if (file-readable-p elc) ; load compiled if present (faster)
+ (setq fn elc)
+ (or (file-readable-p fn)
+ (error "Library %s not found" file)))
+ (if (equal 0 (setq status (call-process emacs nil nil nil
+ "-batch" "-l" fn)))
+ (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)))))
+ (if more
+ (cus-test-get-lisp-files (equal more "all"))
+ (cus-test-get-autoload-deps)))
+ (message "Default directory: %s" default-directory)
+ (when skipped
+ (message "The following libraries were skipped:")
+ (cus-test-message skipped)))))
(defun cus-test-noloads ()
"Find custom options not loaded by `custom-load-symbol'.
in the Emacs source directory."
(interactive)
- (let (cus-loaded)
+ (let ((groups-loaded (cus-test-get-options "" 'cus-load))
+ cus-loaded groups-not-loaded)
(message "Running %s" 'cus-test-load-custom-loads)
(cus-test-load-custom-loads)
- (setq cus-loaded
- (cus-test-get-options ""))
+ (setq cus-loaded (cus-test-get-options ""))
(message "Running %s" 'cus-test-load-libs)
- (cus-test-load-libs)
- (setq cus-test-vars-not-cus-loaded
- (cus-test-get-options ""))
+ (cus-test-load-libs "all")
+ (setq cus-test-vars-not-cus-loaded (cus-test-get-options "")
+ groups-not-loaded (cus-test-get-options "" t))
(dolist (o cus-loaded)
(setq cus-test-vars-not-cus-loaded
(message "No options not loaded by custom-load-symbol found")
(message "The following options were not loaded by custom-load-symbol:")
(cus-test-message
- (sort cus-test-vars-not-cus-loaded 'string<)))))
+ (sort cus-test-vars-not-cus-loaded 'string<)))
-;; And last but not least a quiz:
-;;
-;; Evaluation of the form (customize-option 'debug-on-error) yields a
-;; *Customize* buffer with a mismatch mess. Why?
+ (dolist (o groups-loaded)
+ (setq groups-not-loaded (delete o groups-not-loaded)))
+
+ (if (not groups-not-loaded)
+ (message "No groups not in cus-load.el found")
+ (message "The following groups are not in cus-load.el:")
+ (cus-test-message (sort groups-not-loaded 'string<)))))
(provide 'cus-test)
-;;; arch-tag: a4991a31-548d-48fb-8ba1-1ebbe68eb2e7
;;; cus-test.el ends here
HCoop / bpt / emacs.git / blobdiff