;;; cus-test.el --- tests for custom types and load problems
-;; Copyright (C) 1998, 2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2002-2016 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
;;
(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-get-lisp-files (&optional all)
"Return list of all Lisp files with defcustoms.
-Optional argument ALL non-nil means list all Lisp files."
+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)
;; 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
- (unless all
+ (if all
+ '("-print")
(list "-exec" grep-program
"-l" "^[ \t]*(defcustom" "{}" "+"))))
(message "%sdone" msg))))
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)
+ (let* ((default-directory source-directory)
+ (emacs (expand-file-name "src/emacs"))
+ skipped)
(or (file-executable-p emacs)
- (error "No Emacs executable in %ssrc" default-directory))
+ (error "No such executable `%s'" emacs))
(mapc
(lambda (file)
(if (member file cus-test-libs-noloads)
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<)))
+
+ (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)