declare smobs in alloc.c

[bpt/emacs.git] / admin / cus-test.el

diff --git a/admin/cus-test.el b/admin/cus-test.el
index 11d781e..b60eac2 100644 (file)
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -1,6 +1,6 @@
 ;;; cus-test.el --- tests for custom types and load problems
 
 ;;; 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>
 
 ;; 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
 ;;
 ;;
 ;; 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-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
 ;;
 ;;
 ;;   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'.
 ;; 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:
 
 \f
 ;;; Code:


@@ -136,24 +99,23 @@
 (defvar cus-test-skip-list nil
   "List of variables to disregard by `cus-test-apropos'.")
 
 (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)
 
 
 ;; 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"
 
 ;; 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
      (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))
         (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)
 
           ;; 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)
                   (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))
 
           (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
     (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))))
        (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)
 (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))
 
   (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.
   "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)
   (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 ()
 
 (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"))
   (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."
 
 (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'."
 \f
 ;;; The routines for batch mode:
 
 \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
 
   "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)
   (interactive)

+  (and noninteractive
+       command-line-args-left
+       (setq all (pop command-line-args-left)))

   (message "Running %s" 'cus-test-load-libs)
   (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)
   (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
          ((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
                 (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))
 
     (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
 
   "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)
   (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'.
 
 (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)
 
 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)
 
     (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)
 
     (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
 
     (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
        (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)
 
 
 (provide 'cus-test)