cgit.sxemacs.org Git - packages/blob - xemacs-packages/mh-e/mh-unit.el

   1 ;;; mh-unit.el --- Unit tests for MH-E
   2
   3 ;; Copyright (C) 2003 Bill Wohler
   4
   5 ;; Author: Bill Wohler <wohler@newt.com>
   6 ;; Maintainer: Bill Wohler <wohler@newt.com>
   7 ;; Keywords: mail
   8 ;; See: mh-e.el
   9
  10 ;; This file is part of MH-E.
  11
  12 ;; MH-E is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; MH-E is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with MH-E; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Currently, this file contains unit tests that are useful when releasing
  30 ;; software. I have a dream that we can add unit tests to actually test code.
  31 ;;
  32 ;; To use, add the following to your .emacs and then run "M-x mh-unit".
  33 ;;
  34 ;;   (autoload 'mh-unit "mh-unit")
  35
  36 ;;; Change Log:
  37
  38 ;;; Code:
  39
  40 (require 'lisp-mnt)
  41 (require 'cl)
  42
  43 (defvar mh-unit-files '("mh-alias.el" "mh-comp.el" "mh-customize.el" "mh-e.el"
  44                         "mh-funcs.el" "mh-identity.el" "mh-inc.el"
  45                         "mh-index.el" "mh-junk.el" "mh-loaddefs.el"
  46                         "mh-mime.el" "mh-pick.el" "mh-seq.el" "mh-speed.el"
  47                         "mh-utils.el" "mh-xemacs-compat.el"
  48                         "mh-xemacs-icons.el"))
  49
  50 (defun mh-unit ()
  51   "Run unit test on MH-E.
  52 Currently, the tests are all release related, including:
  53 - Run `lm-verify' on all files.
  54 - Run `checkdoc' on all files.
  55 - Removing trailing space on all files (per GNU Emacs conventions)."
  56   (interactive)
  57   (dolist (file mh-unit-files)
  58     (let ((buffer-exists (find-buffer-visiting file)))
  59       (find-file file)
  60       ;; Previous versions of lm-verify did not handle multiple-line
  61       ;; copyrights which we have as of MH-E version 7.3.
  62       (if (and (>= emacs-major-version 21)
  63                (>= emacs-minor-version 3))
  64           (let ((lm-out (lm-verify file)))
  65             (if lm-out
  66                 (error lm-out))))
  67       (checkdoc)
  68       (mh-unit-prune-trailing-spaces)
  69       (if (not buffer-exists)
  70           (kill-buffer nil)))))
  71
  72 \f
  73
  74 (defun mh-unit-prune-trailing-spaces ()
  75   "Remove all trailing spaces in buffer."
  76   (save-excursion
  77     (goto-char (point-min))
  78     (while (re-search-forward "[ \t]+$" nil t)
  79       (delete-region (match-beginning 0) (match-end 0)))))
  80
  81 \f
  82
  83 ;;; Find possibly dead code...
  84
  85 (defvar mh-unit-call-graph (make-hash-table))
  86 (defvar mh-unit-root-functions (make-hash-table))
  87 (defvar mh-unit-function-definition (make-hash-table))
  88 (defvar mh-unit-fix-point-interation-count 0)
  89 (defvar mh-unit-autoload-regexp
  90   "[ \t\n]*\\(;.*\n\\|\014\n\\|\n\\)*;;;###autoload\n"
  91   "Regexp to recognize an autoload cookie.")
  92
  93 (defun mh-unit-construct-call-graph ()
  94   "Construct call graph for MH-E functions.
  95 The hash maps `mh-unit-call-graph' and `mh-unit-function-definition' are
  96 populated."
  97   (clrhash mh-unit-call-graph)
  98   (clrhash mh-unit-root-functions)
  99   (clrhash mh-unit-function-definition)
 100   (message "Constructing call graph ...")
 101   (loop for file in (remove "mh-loaddefs.el" mh-unit-files)
 102         do (with-temp-buffer
 103              (message "Reading %s ..." file)
 104              (ignore-errors (insert-file-contents-literally file))
 105              (goto-char (point-min))
 106              (loop with eof = (make-symbol "eof")
 107                    for autoloadp = (looking-at mh-unit-autoload-regexp)
 108                    for expr = (condition-case nil (read (current-buffer))
 109                                 (error eof))
 110                    for defunp = (and (consp expr) (eq (car expr) 'defun))
 111                    for defmacrop = (and (consp expr) (eq (car expr) 'defmacro))
 112                    for defcustomp = (and (consp expr)
 113                                          (eq (car expr) 'defcustom))
 114                    for defvarp = (and (consp expr) (eq (car expr) 'defvar))
 115                    for deffacep = (and (consp expr) (eq (car expr) 'defface))
 116                    until (eq expr eof)
 117                    do
 118                    (when autoloadp
 119                      (setf (gethash (cadr expr) mh-unit-root-functions) t))
 120                    (when (or defunp defmacrop)
 121                      (setf (gethash (cadr expr) mh-unit-function-definition)
 122                            file))
 123                    (mh-unit-update-call-graph
 124                     (and (or defunp defmacrop) (cadr expr))
 125                     (cond ((or defunp defmacrop defcustomp defvarp)
 126                            (cddr expr))
 127                           (deffacep nil)
 128                           (t expr)))))
 129         finally do (message "Constructing call graph ...done")))
 130
 131 (defun mh-unit-find-all-used-functions ()
 132   "Find all used functions.
 133 Compute a fixed point to find the set of all called functions. The process is
 134 guaranteed to produce a conservative approximation."
 135   (message "Finding all used functions ...")
 136   (setq mh-unit-fix-point-interation-count 0)
 137   (let* ((init (copy-hash-table mh-unit-root-functions))
 138          (next (mh-unit-called-functions init)))
 139     (while (> (hash-table-count next) (hash-table-count init))
 140       (setq init next)
 141       (setq next (mh-unit-called-functions init)))
 142     next))
 143
 144 (defun mh-unit-called-functions (set)
 145   "Find all the functions that are called by elements of SET.
 146 The returned set includes all the elements of SET and all functions that are
 147 directly called by members of SET."
 148   (message "Iteration %s ..." (incf mh-unit-fix-point-interation-count))
 149   (loop with result = (make-hash-table)
 150         for x being the hash-keys of set
 151         do (setf (gethash x result) t)
 152            (loop for y in (gethash x mh-unit-call-graph)
 153                  do (setf (gethash y result) t))
 154         finally return result))
 155
 156 (defun mh-unit-find-all-unused-functions ()
 157   "Find all the functions that have been defined but never used in MH-E."
 158   (interactive)
 159   (mh-unit-construct-call-graph)
 160   (let ((used-functions (mh-unit-find-all-used-functions))
 161         (results-by-file (make-hash-table))
 162         (count 0))
 163     (loop for x being the hash-keys of mh-unit-function-definition
 164           unless (gethash x used-functions)
 165           do (push x (gethash (gethash x mh-unit-function-definition)
 166                               results-by-file)))
 167     (with-current-buffer (get-buffer-create "*MH-E Unit Results*")
 168       (erase-buffer)
 169       (loop for file being the hash-keys of results-by-file
 170             do (progn
 171                  (insert file "\n")
 172                  (loop for x in (gethash file results-by-file)
 173                        do (insert "  " (symbol-name x) "\n") (incf count))
 174                  (insert "\n"))))
 175     (if (equal (hash-table-count results-by-file) 0)
 176         (message "No unused functions in MH-E")
 177       (message "Found %s unused functions in %s files"
 178                count (hash-table-count results-by-file))
 179       (display-buffer "*MH-E Unit Results*"))))
 180
 181 (defun mh-unit-update-call-graph (node expr)
 182   "Add edges to function call graph.
 183 The body of NODE is EXPR. If NODE is nil, then EXPR is a top level expression.
 184 An edge is added from NODE to every possible function in EXPR."
 185   (cond ((and (atom expr) node) (push expr (gethash node mh-unit-call-graph)))
 186         ((atom expr) (setf (gethash expr mh-unit-root-functions) t))
 187         (t (loop for x in expr do (mh-unit-update-call-graph node x)))))
 188
 189 (provide 'mh-unit)
 190
 191 ;;; Local Variables:
 192 ;;; indent-tabs-mode: nil
 193 ;;; sentence-end-double-space: nil
 194 ;;; End:
 195
 196 ;;; mh-unit.el ends here