* admin/update_autogen: Auto-detect VCS in use.

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

diff --git a/admin/cus-test.el b/admin/cus-test.el
index e68ee77..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
 
-;; Copyright (C) 1998, 2000, 2002-2013 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>
@@ -187,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))
@@ -202,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)
@@ -232,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))))
@@ -492,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 "all")
-    (setq cus-test-vars-not-cus-loaded
-         (cus-test-get-options ""))
+    (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
@@ -512,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)