X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a3f276d8ffee80c17919aea509400767d800d4bb..10e00bd5b43c277ab59f336966a4a3ed35678d40:/admin/cus-test.el diff --git a/admin/cus-test.el b/admin/cus-test.el index 90fb40b77c..b60eac28d2 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -1,6 +1,6 @@ ;;; 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-2014 Free Software Foundation, Inc. ;; Author: Markus Rost ;; Maintainer: Markus Rost @@ -30,11 +30,11 @@ ;; ;; 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 ;; @@ -99,9 +99,14 @@ (defvar cus-test-skip-list nil "List of variables to disregard by `cus-test-apropos'.") -;; Loading dunnet in batch mode leads to a Dead end. -(defvar cus-test-libs-noloads '("play/dunnet.el" "emulation/edt-mapper.el" - "loadup.el" "mail/blessmail.el") +(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.") @@ -182,6 +187,9 @@ The detected problematic options are stored in `cus-test-errors'." (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)) @@ -197,6 +205,8 @@ The detected problematic options are stored in `cus-test-errors'." ;; 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) @@ -227,17 +237,38 @@ The detected problematic options are stored in `cus-test-errors'." (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)))) @@ -277,9 +308,11 @@ The detected problematic options are stored in `cus-test-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 () +(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) (cus-test-load-1 (let ((lispdir (file-name-directory (locate-library "loaddefs")))) @@ -292,7 +325,9 @@ Don't load libraries in `cus-test-libs-noloads'." (error (push (cons file alpha) cus-test-libs-errors) (message "Error for %s: %s" file alpha)))) - (cus-test-get-autoload-deps))))) + (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 files with autoloads." @@ -305,7 +340,7 @@ Don't load libraries in `cus-test-libs-noloads'." (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) @@ -313,8 +348,10 @@ Optional argument ALL non-nil means list all Lisp files." ;; Hack to remove leading "./". (mapcar (lambda (e) (substring e 2)) (apply 'process-lines find-program - "-name" "*.el" - (unless all + "-name" "obsolete" "-prune" "-o" + "-name" "[^.]*.el" ; ignore .dir-locals.el + (if all + '("-print") (list "-exec" grep-program "-l" "^[ \t]*(defcustom" "{}" "+")))) (message "%sdone" msg)))) @@ -326,16 +363,21 @@ Optional argument ALL non-nil means list all Lisp files." ;;; 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) @@ -434,11 +476,11 @@ If it is \"all\", load all Lisp files." 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) @@ -476,17 +518,17 @@ It is suitable for batch mode. E.g., invoke 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 @@ -496,7 +538,15 @@ in the Emacs source directory." (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)