mh-e / mh-unit.el

Diff from to


 ;; 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")
 ;;; Change Log:
 ;;; Code:
 (require 'lisp-mnt)
+(require 'cl)
-(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"
+                        "mh-xemacs-icons.el"))
 (defun mh-unit ()
-  "Run unit tests 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)
-    (find-file file)
-    (let ((lm-out (lm-verify file)))
-      (if lm-out
-          (error lm-out)))
-    (checkdoc)
-    (mh-prune-trailing-spaces)))
+  (dolist (file mh-unit-files)
+    (let ((buffer-exists (find-buffer-visiting file)))
+      (find-file 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 lm-out
+                (error lm-out))))
+      (checkdoc)
+      (mh-unit-prune-trailing-spaces)
+      (if (not buffer-exists)
+          (kill-buffer nil)))))
-(defun mh-prune-trailing-spaces ()
+(defun mh-unit-prune-trailing-spaces ()
   "Remove all trailing spaces in buffer."
     (goto-char (point-min))
     (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)
+(defvar mh-unit-autoload-regexp
+  "[ \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)
+        do (with-temp-buffer
+             (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))
+                                (error eof))
+                   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))
+                   until (eq expr eof)
+                   do
+                   (when autoloadp
+                     (setf (gethash (cadr expr) mh-unit-root-functions) t))
+                   (when (or defunp defmacrop)
+                     (setf (gethash (cadr expr) mh-unit-function-definition)
+                           file))
+                   (mh-unit-update-call-graph
+                    (and (or defunp defmacrop) (cadr expr))
+                    (cond ((or defunp defmacrop defcustomp defvarp)
+                           (cddr expr))
+                          (deffacep nil)
+                          (t expr)))))
+        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 init next)
+      (setq next (mh-unit-called-functions init)))
+    next))
+(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."
+  (interactive)
+  (mh-unit-construct-call-graph)
+  (let ((used-functions (mh-unit-find-all-used-functions))
+        (results-by-file (make-hash-table))
+        (count 0))
+    (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)
+                              results-by-file)))
+    (with-current-buffer (get-buffer-create "*MH-E Unit Results*")
+      (erase-buffer)
+      (loop for file being the hash-keys of results-by-file
+            do (progn
+                 (insert file "\n")
+                 (loop for x in (gethash file results-by-file)
+                       do (insert "  " (symbol-name x) "\n") (incf count))
+                 (insert "\n"))))
+    (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)))))
 (provide 'mh-unit)
 ;;; Local Variables: