;; Currently, this file contains unit tests that are useful when releasing
;; software. I have a dream that we can add unit tests to actually test code.
+;; To use, add the following to your .emacs and then run "M-x mh-unit".
+;; (autoload 'mh-unit "mh-unit")
-(defvar mh-files '("mh-alias.el" "mh-comp.el" "mh-customize.el" "mh-e.el"
- "mh-funcs.el" "mh-identity.el" "mh-inc.el" "mh-index.el"
- "mh-junk.el" "mh-loaddefs.el" "mh-mime.el" "mh-pick.el"
- "mh-seq.el" "mh-speed.el" "mh-utils.el"
- "mh-xemacs-compat.el" "mh-xemacs-icons.el"))
+(defvar mh-unit-files '("mh-alias.el" "mh-comp.el" "mh-customize.el" "mh-e.el"
+ "mh-funcs.el" "mh-identity.el" "mh-inc.el"
+ "mh-index.el" "mh-junk.el" "mh-loaddefs.el"
+ "mh-mime.el" "mh-pick.el" "mh-seq.el" "mh-speed.el"
+ "mh-utils.el" "mh-xemacs-compat.el"
- "Run unit test
s on MH-E.
+ "Run unit test on MH-E.
Currently, the tests are all release related, including:
- Run `lm-verify' on all files.
- Run `checkdoc' on all files.
- Removing trailing space on all files (per GNU Emacs conventions)."
- (dolist (file mh-files)
- (let ((lm-out (lm-verify file)))
+ (dolist (file mh-unit-files)
+ (let ((buffer-exists (find-buffer-visiting file)))
+ ;; Previous versions of lm-verify did not handle multiple-line
+ ;; copyrights which we have as of MH-E version 7.3.
+ (if (and (>= emacs-major-version 21)
+ (>= emacs-minor-version 3))
+ (let ((lm-out (lm-verify file)))
+ (if (not buffer-exists)
-(defun mh-prune-trailing-spaces ()
+(defun mh-unit-prune-trailing-spaces ()
"Remove all trailing spaces in buffer."
(while (re-search-forward "[ \t]+$" nil t)
(delete-region (match-beginning 0) (match-end 0)))))
+;;; Find possibly dead code...
+(defvar mh-unit-call-graph (make-hash-table))
+(defvar mh-unit-root-functions (make-hash-table))
+(defvar mh-unit-function-definition (make-hash-table))
+(defvar mh-unit-fix-point-interation-count 0)
+ "[ \t\n]*\\(;.*\n\\|\014\n\\|\n\\)*;;;###autoload\n"
+ "Regexp to recognize an autoload cookie.")
+(defun mh-unit-construct-call-graph ()
+ "Construct call graph for MH-E functions.
+The hash maps `mh-unit-call-graph' and `mh-unit-function-definition' are
+ (clrhash mh-unit-call-graph)
+ (clrhash mh-unit-root-functions)
+ (clrhash mh-unit-function-definition)
+ (message "Constructing call graph ...")
+ (loop for file in (remove "mh-loaddefs.el" mh-unit-files)
+ (message "Reading %s ..." file)
+ (ignore-errors (insert-file-contents-literally file))
+ (goto-char (point-min))
+ (loop with eof = (make-symbol "eof")
+ for autoloadp = (looking-at mh-unit-autoload-regexp)
+ for expr = (condition-case nil (read (current-buffer))
+ for defunp = (and (consp expr) (eq (car expr) 'defun))
+ for defmacrop = (and (consp expr) (eq (car expr) 'defmacro))
+ for defcustomp = (and (consp expr)
+ (eq (car expr) 'defcustom))
+ for defvarp = (and (consp expr) (eq (car expr) 'defvar))
+ for deffacep = (and (consp expr) (eq (car expr) 'defface))
+ (setf (gethash (cadr expr) mh-unit-root-functions) t))
+ (when (or defunp defmacrop)
+ (setf (gethash (cadr expr) mh-unit-function-definition)
+ (and (or defunp defmacrop) (cadr expr))
+ (cond ((or defunp defmacrop defcustomp defvarp)
+ finally do (message "Constructing call graph ...done")))
+(defun mh-unit-find-all-used-functions ()
+ "Find all used functions.
+Compute a fixed point to find the set of all called functions. The process is
+guaranteed to produce a conservative approximation."
+ (message "Finding all used functions ...")
+ (setq mh-unit-fix-point-interation-count 0)
+ (let* ((init (copy-hash-table mh-unit-root-functions))
+ (next (mh-unit-called-functions init)))
+ (while (> (hash-table-count next) (hash-table-count init))
+ (setq next (mh-unit-called-functions init)))
+(defun mh-unit-called-functions (set)
+ "Find all the functions that are called by elements of SET.
+The returned set includes all the elements of SET and all functions that are
+directly called by members of SET."
+ (message "Iteration %s ..." (incf mh-unit-fix-point-interation-count))
+ (loop with result = (make-hash-table)
+ for x being the hash-keys of set
+ do (setf (gethash x result) t)
+ (loop for y in (gethash x mh-unit-call-graph)
+ do (setf (gethash y result) t))
+ finally return result))
+(defun mh-unit-find-all-unused-functions ()
+ "Find all the functions that have been defined but never used in MH-E."
+ (let ((used-functions (mh-unit-find-all-used-functions))
+ (results-by-file (make-hash-table))
+ (loop for x being the hash-keys of mh-unit-function-definition
+ unless (gethash x used-functions)
+ do (push x (gethash (gethash x mh-unit-function-definition)
+ (with-current-buffer (get-buffer-create "*MH-E Unit Results*")
+ (loop for file being the hash-keys of results-by-file
+ (loop for x in (gethash file results-by-file)
+ do (insert " " (symbol-name x) "\n") (incf count))
+ (if (equal (hash-table-count results-by-file) 0)
+ (message "No unused functions in MH-E")
+ (message "Found %s unused functions in %s files"
+ count (hash-table-count results-by-file))
+ (display-buffer "*MH-E Unit Results*"))))
+(defun mh-unit-update-call-graph (node expr)
+ "Add edges to function call graph.
+The body of NODE is EXPR. If NODE is nil, then EXPR is a top level expression.
+An edge is added from NODE to every possible function in EXPR."
+ (cond ((and (atom expr) node) (push expr (gethash node mh-unit-call-graph)))
+ ((atom expr) (setf (gethash expr mh-unit-root-functions) t))
+ (t (loop for x in expr do (mh-unit-update-call-graph node x)))))