X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5244bc019bf7376caff3bb198ff674e0ad9fb0e6..refs/heads/wip:/admin/cus-test.el

diff --git a/admin/cus-test.el b/admin/cus-test.el
index 11d781ed01..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-2012  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>
@@ -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
 ;;
@@ -87,43 +87,6 @@
 ;; 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
 
 
 ;;; Code:
@@ -136,24 +99,23 @@
 (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"
@@ -225,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))
@@ -240,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)
@@ -270,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))))
@@ -302,49 +290,71 @@ The detected problematic options are stored in `cus-test-errors'."
 (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."
@@ -353,16 +363,21 @@ Don't load libraries in `cus-test-libs-noloads'."
 
 ;;; 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)
@@ -392,7 +407,8 @@ in the Emacs source directory."
 	  ((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
@@ -444,47 +460,54 @@ in the Emacs source directory."
     (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'.
@@ -495,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
@@ -515,12 +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<)))
 
-;; 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)