Source

mh-e / mh-unit.el

Full commit
;;; mh-unit.el --- Unit tests for MH-E

;; Copyright (C) 2003 Bill Wohler

;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el

;; This file is part of MH-E.

;; MH-E is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; MH-E is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with MH-E; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 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-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 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)."
  (interactive)
  (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-unit-prune-trailing-spaces ()
  "Remove all trailing spaces in buffer."
  (save-excursion
    (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
populated."
  (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:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:

;;; mh-unit.el ends here