tests/cedet-uutil.el

   1 ;;; cedet-uutil.el --- Unit test utilities for the CEDET suite.
   2 ;;
   3 ;; Copyright (C) 2011, 2014 Eric M. Ludlam
   4 ;;
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6 ;;
   7 ;; This program is free software; you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see http://www.gnu.org/licenses/.
  19
  20 ;;; Commentary:
  21 ;;
  22 ;; Utilities needed to run the complete CEDET unit test suite.
  23
  24 ;;; Code:
  25 (defvar cedet-running-master-tests nil
  26   "Non-nil when CEDET-utest is running all the tests.")
  27
  28 (defun cedet-utest-noninteractive ()
  29   "Return non-nil if running non-interactively."
  30   (if (featurep 'xemacs)
  31       (noninteractive)
  32     noninteractive))
  33
  34 (defvar cedet-utest-root (let ((CEDETDIR (file-name-directory
  35                                           (or load-file-name (buffer-file-name)))))
  36                            (file-name-directory CEDETDIR))
  37   "Location of the CEDET test suites.")
  38
  39 ;;; Logging utility.
  40 ;;
  41 (defvar cedet-utest-frame nil
  42   "Frame used during cedet unit test logging.")
  43 (defvar cedet-utest-buffer nil
  44   "Frame used during cedet unit test logging.")
  45 (defvar cedet-utest-frame-parameters
  46   '((name . "CEDET-UTEST")
  47     (width . 80)
  48     (height . 25)
  49     (minibuffer . t))
  50   "Frame parameters used for the cedet utest log frame.")
  51
  52 (defvar cedet-utest-last-log-item nil
  53   "Remember the last item we were logging for.")
  54
  55 (defvar cedet-utest-log-timer nil
  56   "During a test, track the start time.")
  57
  58 (defun cedet-utest-log-setup (&optional title)
  59   "Setup a frame and buffer for unit testing.
  60 Optional argument TITLE is the title of this testing session."
  61   (setq cedet-utest-log-timer (current-time))
  62   (if (cedet-utest-noninteractive)
  63       (message "\n>> Setting up %s tests to run @ %s\n"
  64                (or title "")
  65                (current-time-string))
  66
  67     ;; Interactive mode needs a frame and buffer.
  68     (when (or (not cedet-utest-frame) (not (frame-live-p cedet-utest-frame)))
  69       (setq cedet-utest-frame (make-frame cedet-utest-frame-parameters)))
  70     (when (or (not cedet-utest-buffer) (not (buffer-live-p cedet-utest-buffer)))
  71       (setq cedet-utest-buffer (get-buffer-create "*CEDET utest log*")))
  72     (save-excursion
  73       (set-buffer cedet-utest-buffer)
  74       (setq cedet-utest-last-log-item nil)
  75       (when (not cedet-running-master-tests)
  76         (erase-buffer))
  77       (insert "\n\nSetting up "
  78               (or title "")
  79               " tests to run @ " (current-time-string) "\n\n"))
  80     (let ((oframe (selected-frame)))
  81       (unwind-protect
  82           (progn
  83             (select-frame cedet-utest-frame)
  84             (switch-to-buffer cedet-utest-buffer t))
  85         (select-frame oframe)))
  86     ))
  87
  88 (defun cedet-utest-elapsed-time (start end)
  89   "Copied from elp.el.  Was elp-elapsed-time.
  90 Argument START and END bound the time being calculated."
  91   (+ (* (- (car end) (car start)) 65536.0)
  92      (- (car (cdr end)) (car (cdr start)))
  93      (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
  94
  95 (defun cedet-utest-log-shutdown (title &optional errorcondition)
  96   "Shut-down a larger test suite.
  97 TITLE is the section that is done.
  98 ERRORCONDITION is some error that may have occured durinig testing."
  99   (let ((endtime (current-time))
 100         )
 101     (cedet-utest-log-shutdown-msg title cedet-utest-log-timer endtime)
 102     (setq cedet-utest-log-timer nil)
 103
 104     ;; If this isn't working in batch mode for testing, perhaps
 105     ;; we can use an output message, and collect errors to the
 106     ;; very end?
 107     (when errorcondition (error errorcondition))
 108     ))
 109
 110 (defun cedet-utest-log-shutdown-msg (title startime endtime)
 111   "Show a shutdown message with TITLE, STARTIME, and ENDTIME."
 112   (if (cedet-utest-noninteractive)
 113       (progn
 114         (message "\n>> Test Suite %s ended at @ %s"
 115                  title
 116                  (format-time-string "%c" endtime))
 117         (message "     Elapsed Time %.2f Seconds\n"
 118                  (cedet-utest-elapsed-time startime endtime)))
 119
 120     (save-excursion
 121       (set-buffer cedet-utest-buffer)
 122       (goto-char (point-max))
 123       (insert "\n>> Test Suite " title " ended at @ "
 124               (format-time-string "%c" endtime) "\n"
 125               "     Elapsed Time "
 126               (number-to-string
 127                (cedet-utest-elapsed-time startime endtime))
 128               " Seconds\n * "))
 129     ))
 130
 131 (defun cedet-utest-show-log-end ()
 132   "Show the end of the current unit test log."
 133   (unless (cedet-utest-noninteractive)
 134     (let* ((cb (current-buffer))
 135            (cf (selected-frame))
 136            (bw (or (get-buffer-window cedet-utest-buffer t)
 137                    (get-buffer-window (switch-to-buffer cedet-utest-buffer) t)))
 138            (lf (window-frame bw))
 139            )
 140       (select-frame lf)
 141       (select-window bw)
 142       (goto-char (point-max))
 143       (select-frame cf)
 144       (set-buffer cb)
 145       )))
 146
 147 (defun cedet-utest-post-command-hook ()
 148   "Hook run after the current log command was run."
 149     (if (cedet-utest-noninteractive)
 150         (message "")
 151       (save-excursion
 152         (set-buffer cedet-utest-buffer)
 153         (goto-char (point-max))
 154         (insert "\n\n")))
 155     (setq cedet-utest-last-log-item nil)
 156     (remove-hook 'post-command-hook 'cedet-utest-post-command-hook)
 157     )
 158
 159 (defun cedet-utest-add-log-item-start (item)
 160   "Add ITEM into the log as being started."
 161   (unless (equal item cedet-utest-last-log-item)
 162     (setq cedet-utest-last-log-item item)
 163     ;; This next line makes sure we clear out status during logging.
 164     (add-hook 'post-command-hook 'cedet-utest-post-command-hook)
 165
 166     (if (cedet-utest-noninteractive)
 167         (message " - Running %s ..." item)
 168       (save-excursion
 169         (set-buffer cedet-utest-buffer)
 170         (goto-char (point-max))
 171         (when (not (bolp)) (insert "\n"))
 172         (insert "Running " item " ... ")
 173         (sit-for 0)
 174         ))
 175     (cedet-utest-show-log-end)
 176     ))
 177
 178 (defun cedet-utest-add-log-item-done (&optional notes err precr)
 179   "Add into the log that the last item is done.
 180 Apply NOTES to the doneness of the log.
 181 Apply ERR if there was an error in previous item.
 182 Optional argument PRECR indicates to prefix the done msg w/ a newline."
 183   (if (cedet-utest-noninteractive)
 184       ;; Non-interactive-mode - show a message.
 185       (if notes
 186           (message "   * %s {%s}" (or err "done") notes)
 187         (message "   * %s" (or err "done")))
 188     ;; Interactive-mode - insert into the buffer.
 189     (save-excursion
 190       (set-buffer cedet-utest-buffer)
 191       (goto-char (point-max))
 192       (when precr (insert "\n"))
 193       (if err
 194           (insert err)
 195         (insert "done")
 196         (when notes (insert " (" notes ")")))
 197       (insert "\n")
 198       (setq cedet-utest-last-log-item nil)
 199       (sit-for 0)
 200       )))
 201
 202 ;;; INDIVIDUAL TEST API
 203 ;;
 204 ;; Use these APIs to start and log information.
 205 ;;
 206 ;; The other fcns will be used to log across all the tests at once.
 207 (defun cedet-utest-log-start (testname)
 208   "Setup the log for the test TESTNAME."
 209   ;; Make sure we have a log buffer.
 210   (save-window-excursion
 211     (when (or (not cedet-utest-buffer)
 212               (not (buffer-live-p cedet-utest-buffer))
 213               (not (get-buffer-window cedet-utest-buffer t))
 214               )
 215       (cedet-utest-log-setup))
 216     ;; Add our startup message.
 217     (cedet-utest-add-log-item-start testname)
 218     ))
 219
 220 (defun cedet-utest-log(format &rest args)
 221   "Log the text string FORMAT.
 222 The rest of the ARGS are used to fill in FORMAT with `format'.
 223 Makes sure the log entry is on its own line, and ends in a CR."
 224   (if (cedet-utest-noninteractive)
 225       (apply 'message format args)
 226     (save-excursion
 227       (set-buffer cedet-utest-buffer)
 228       (goto-char (point-max))
 229       (when (not (bolp)) (insert "\n"))
 230       (insert (apply 'format format args))
 231       (insert "\n")
 232       (sit-for 0)
 233       ))
 234   (cedet-utest-show-log-end)
 235   )
 236
 237 (provide 'cedet-uutil)
 238
 239 ;;; utest-util.el ends here