code.delx.au - gnu-emacs/blob - test/cedet/cedet-utests.el

   1 ;;; cedet-utests.el --- Run all unit tests in the CEDET suite.
   2
   3 ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Remembering to run all the unit tests available in CEDET one at a
  25 ;; time is a bit time consuming.  This links all the tests together
  26 ;; into one command.
  27
  28 (require 'cedet)
  29 ;;; Code:
  30 (defvar cedet-utest-test-alist
  31   '(
  32     ;;
  33     ;; COMMON
  34     ;;
  35
  36     ;; Test inversion
  37     ("inversion" . inversion-unit-test)
  38
  39     ;; EZ Image dumping.
  40     ("ezimage associations" . ezimage-image-association-dump)
  41     ("ezimage images" . ezimage-image-dump)
  42
  43     ;; Workging interactive tests.
  44     ("working: wait-for-keypress" .
  45      (lambda ()
  46        (if (cedet-utest-noninteractive)
  47            (message " ** Skipping test in noninteractive mode.")
  48          (working-wait-for-keypress))))
  49     ;("working: sleep" . working-verify-sleep)
  50
  51     ;; Pulse
  52     ("pulse interactive test" . (lambda () (pulse-test t)))
  53
  54     ;; Files
  55     ("cedet file conversion" . cedet-files-utest)
  56
  57     ;;
  58     ;; EIEIO
  59     ;;
  60     ("eieio" . (lambda () (let ((lib (locate-library "eieio-tests.el"
  61                                                      t)))
  62                             (load-file lib))))
  63     ("eieio: browser" . eieio-browse)
  64     ("eieio: custom" . (lambda ()
  65                          (require 'eieio-custom)
  66                          (customize-variable 'eieio-widget-test)))
  67     ("eieio: chart" . (lambda ()
  68                         (if (cedet-utest-noninteractive)
  69                             (message " ** Skipping test in noninteractive mode.")
  70                           (chart-test-it-all))))
  71     ;;
  72     ;; EDE
  73     ;;
  74
  75     ;; @todo - Currently handled in the integration tests.  Need
  76     ;;         some simpler unit tests here.
  77
  78     ;;
  79     ;; SEMANTIC
  80     ;;
  81     ("semantic: lex spp table write" . semantic-lex-spp-write-utest)
  82     ("semantic: multi-lang parsing" . semantic-utest-main)
  83     ("semantic: C preprocessor" . semantic-utest-c)
  84     ("semantic: analyzer tests" . semantic-ia-utest)
  85     ("semanticdb: data cache" . semantic-test-data-cache)
  86     ("semantic: throw-on-input" .
  87      (lambda ()
  88        (if (cedet-utest-noninteractive)
  89            (message " ** Skipping test in noninteractive mode.")
  90          (semantic-test-throw-on-input))))
  91
  92     ("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
  93     ;;
  94     ;; SRECODE
  95     ;;
  96     ("srecode: fields" . srecode-field-utest)
  97     ("srecode: templates" . srecode-utest-template-output)
  98     ("srecode: show maps" . srecode-get-maps)
  99     ("srecode: getset" . srecode-utest-getset-output)
 100
 101     ;;
 102     ;; COGRE
 103     ;;
 104     ("cogre: graph" . cogre-utest)
 105     ("cogre: periodic & ascii" . cogre-periodic-utest)
 106     ("cogre: conversion/export tests" . cogre-export-utest)
 107     ("cogre: uml-quick-class" . cogre-utest-quick-class)
 108    )
 109   "Alist of all the tests in CEDET we should run.")
 110
 111 (defvar cedet-running-master-tests nil
 112   "Non-nil when CEDET-utest is running all the tests.")
 113
 114 ;;;###autoload
 115 (defun cedet-utest (&optional exit-on-error)
 116   "Run the CEDET unittests.
 117 EXIT-ON-ERROR causes the test suite to exit on an error, instead
 118 of just logging the error."
 119   (interactive)
 120   (if (or (not (featurep 'semanticdb-mode))
 121           (not (semanticdb-minor-mode-p)))
 122       (error "CEDET Tests require: M-x semantic-load-enable-minimum-features"))
 123   (cedet-utest-log-setup "ALL TESTS")
 124   (let ((tl cedet-utest-test-alist)
 125         (notes nil)
 126         (err nil)
 127         (start (current-time))
 128         (end nil)
 129         (cedet-running-master-tests t)
 130         )
 131     (dolist (T tl)
 132       (cedet-utest-add-log-item-start (car T))
 133       (setq notes nil err nil)
 134       (condition-case Cerr
 135           (progn
 136             (funcall (cdr T))
 137             )
 138         (error
 139          (setq err (format "ERROR: %S" Cerr))
 140          ;;(message "Error caught: %s" Cerr)
 141          ))
 142
 143       ;; Cleanup stray input and events that are in the way.
 144       ;; Not doing this causes sit-for to not refresh the screen.
 145       ;; Doing this causes the user to need to press keys more frequently.
 146       (when (and (interactive-p) (input-pending-p))
 147         (if (fboundp 'read-event)
 148             (read-event)
 149           (read-char)))
 150
 151       (cedet-utest-add-log-item-done notes err)
 152       (when (and exit-on-error err)
 153         (message "to debug this test point, execute:")
 154         (message "%S" (cdr T))
 155         (message "\n ** Exiting Test Suite. ** \n")
 156         (throw 'cedet-utest-exit-on-error t)
 157         )
 158       )
 159     (setq end (current-time))
 160     (cedet-utest-log-shutdown-msg "ALL TESTS" start end)
 161     nil))
 162
 163 (defun cedet-utest-noninteractive ()
 164   "Return non-nil if running non-interactively."
 165   (if (featurep 'xemacs)
 166       (noninteractive)
 167     noninteractive))
 168
 169 ;;;###autoload
 170 (defun cedet-utest-batch ()
 171   "Run the CEDET unit test in BATCH mode."
 172   (unless (cedet-utest-noninteractive)
 173     (error "`cedet-utest-batch' is to be used only with -batch"))
 174   (condition-case err
 175       (when (catch 'cedet-utest-exit-on-error
 176               ;; Get basic semantic features up.
 177               (semantic-load-enable-minimum-features)
 178               ;; Disables all caches related to semantic DB so all
 179               ;; tests run as if we have bootstrapped CEDET for the
 180               ;; first time.
 181               (setq-default semanticdb-new-database-class 'semanticdb-project-database)
 182               (message "Disabling existing Semantic Database Caches.")
 183
 184               ;; Disabling the srecoder map, we won't load a pre-existing one
 185               ;; and will be forced to bootstrap a new one.
 186               (setq srecode-map-save-file nil)
 187
 188               ;; Run the tests
 189               (cedet-utest t)
 190               )
 191         (kill-emacs 1))
 192     (error
 193      (error "Error in unit test harness:\n  %S" err))
 194     )
 195   )
 196
 197 ;;; Logging utility.
 198 ;;
 199 (defvar cedet-utest-frame nil
 200   "Frame used during cedet unit test logging.")
 201 (defvar cedet-utest-buffer nil
 202   "Frame used during cedet unit test logging.")
 203 (defvar cedet-utest-frame-parameters
 204   '((name . "CEDET-UTEST")
 205     (width . 80)
 206     (height . 25)
 207     (minibuffer . t))
 208   "Frame parameters used for the cedet utest log frame.")
 209
 210 (defvar cedet-utest-last-log-item nil
 211   "Remember the last item we were logging for.")
 212
 213 (defvar cedet-utest-log-timer nil
 214   "During a test, track the start time.")
 215
 216 (defun cedet-utest-log-setup (&optional title)
 217   "Setup a frame and buffer for unit testing.
 218 Optional argument TITLE is the title of this testing session."
 219   (setq cedet-utest-log-timer (current-time))
 220   (if (cedet-utest-noninteractive)
 221       (message "\n>> Setting up %s tests to run @ %s\n"
 222                (or title "")
 223                (current-time-string))
 224
 225     ;; Interactive mode needs a frame and buffer.
 226     (when (or (not cedet-utest-frame) (not (frame-live-p cedet-utest-frame)))
 227       (setq cedet-utest-frame (make-frame cedet-utest-frame-parameters)))
 228     (when (or (not cedet-utest-buffer) (not (buffer-live-p cedet-utest-buffer)))
 229       (setq cedet-utest-buffer (get-buffer-create "*CEDET utest log*")))
 230     (save-excursion
 231       (set-buffer cedet-utest-buffer)
 232       (setq cedet-utest-last-log-item nil)
 233       (when (not cedet-running-master-tests)
 234         (erase-buffer))
 235       (insert "\n\nSetting up "
 236               (or title "")
 237               " tests to run @ " (current-time-string) "\n\n"))
 238     (let ((oframe (selected-frame)))
 239       (unwind-protect
 240           (progn
 241             (select-frame cedet-utest-frame)
 242             (switch-to-buffer cedet-utest-buffer t))
 243         (select-frame oframe)))
 244     ))
 245
 246 (defun cedet-utest-elapsed-time (start end)
 247   "Copied from elp.el.  Was elp-elapsed-time.
 248 Argument START and END bound the time being calculated."
 249   (+ (* (- (car end) (car start)) 65536.0)
 250      (- (car (cdr end)) (car (cdr start)))
 251      (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
 252
 253 (defun cedet-utest-log-shutdown (title &optional errorcondition)
 254   "Shut-down a larger test suite.
 255 TITLE is the section that is done.
 256 ERRORCONDITION is some error that may have occured durinig testing."
 257   (let ((endtime (current-time))
 258         )
 259     (cedet-utest-log-shutdown-msg title cedet-utest-log-timer endtime)
 260     (setq cedet-utest-log-timer nil)
 261     ))
 262
 263 (defun cedet-utest-log-shutdown-msg (title startime endtime)
 264   "Show a shutdown message with TITLE, STARTIME, and ENDTIME."
 265   (if (cedet-utest-noninteractive)
 266       (progn
 267         (message "\n>> Test Suite %s ended at @ %s"
 268                  title
 269                  (format-time-string "%c" endtime))
 270         (message "     Elapsed Time %.2f Seconds\n"
 271                  (cedet-utest-elapsed-time startime endtime)))
 272
 273     (save-excursion
 274       (set-buffer cedet-utest-buffer)
 275       (goto-char (point-max))
 276       (insert "\n>> Test Suite " title " ended at @ "
 277               (format-time-string "%c" endtime) "\n"
 278               "     Elapsed Time "
 279               (number-to-string
 280                (cedet-utest-elapsed-time startime endtime))
 281               " Seconds\n * "))
 282     ))
 283
 284 (defun cedet-utest-show-log-end ()
 285   "Show the end of the current unit test log."
 286   (unless (cedet-utest-noninteractive)
 287     (let* ((cb (current-buffer))
 288            (cf (selected-frame))
 289            (bw (or (get-buffer-window cedet-utest-buffer t)
 290                    (get-buffer-window (switch-to-buffer cedet-utest-buffer) t)))
 291            (lf (window-frame bw))
 292            )
 293       (select-frame lf)
 294       (select-window bw)
 295       (goto-char (point-max))
 296       (select-frame cf)
 297       (set-buffer cb)
 298       )))
 299
 300 (defun cedet-utest-post-command-hook ()
 301   "Hook run after the current log command was run."
 302     (if (cedet-utest-noninteractive)
 303         (message "")
 304       (save-excursion
 305         (set-buffer cedet-utest-buffer)
 306         (goto-char (point-max))
 307         (insert "\n\n")))
 308     (setq cedet-utest-last-log-item nil)
 309     (remove-hook 'post-command-hook 'cedet-utest-post-command-hook)
 310     )
 311
 312 (defun cedet-utest-add-log-item-start (item)
 313   "Add ITEM into the log as being started."
 314   (unless (equal item cedet-utest-last-log-item)
 315     (setq cedet-utest-last-log-item item)
 316     ;; This next line makes sure we clear out status during logging.
 317     (add-hook 'post-command-hook 'cedet-utest-post-command-hook)
 318
 319     (if (cedet-utest-noninteractive)
 320         (message " - Running %s ..." item)
 321       (save-excursion
 322         (set-buffer cedet-utest-buffer)
 323         (goto-char (point-max))
 324         (when (not (bolp)) (insert "\n"))
 325         (insert "Running " item " ... ")
 326         (sit-for 0)
 327         ))
 328     (cedet-utest-show-log-end)
 329     ))
 330
 331 (defun cedet-utest-add-log-item-done (&optional notes err precr)
 332   "Add into the log that the last item is done.
 333 Apply NOTES to the doneness of the log.
 334 Apply ERR if there was an error in previous item.
 335 Optional argument PRECR indicates to prefix the done msg w/ a newline."
 336   (if (cedet-utest-noninteractive)
 337       ;; Non-interactive-mode - show a message.
 338       (if notes
 339           (message "   * %s {%s}" (or err "done") notes)
 340         (message "   * %s" (or err "done")))
 341     ;; Interactive-mode - insert into the buffer.
 342     (save-excursion
 343       (set-buffer cedet-utest-buffer)
 344       (goto-char (point-max))
 345       (when precr (insert "\n"))
 346       (if err
 347           (insert err)
 348         (insert "done")
 349         (when notes (insert " (" notes ")")))
 350       (insert "\n")
 351       (setq cedet-utest-last-log-item nil)
 352       (sit-for 0)
 353       )))
 354
 355 ;;; INDIVIDUAL TEST API
 356 ;;
 357 ;; Use these APIs to start and log information.
 358 ;;
 359 ;; The other fcns will be used to log across all the tests at once.
 360 (defun cedet-utest-log-start (testname)
 361   "Setup the log for the test TESTNAME."
 362   ;; Make sure we have a log buffer.
 363   (save-window-excursion
 364     (when (or (not cedet-utest-buffer)
 365               (not (buffer-live-p cedet-utest-buffer))
 366               (not (get-buffer-window cedet-utest-buffer t))
 367               )
 368       (cedet-utest-log-setup))
 369     ;; Add our startup message.
 370     (cedet-utest-add-log-item-start testname)
 371     ))
 372
 373 (defun cedet-utest-log(format &rest args)
 374   "Log the text string FORMAT.
 375 The rest of the ARGS are used to fill in FORMAT with `format'."
 376   (if (cedet-utest-noninteractive)
 377       (apply 'message format args)
 378     (save-excursion
 379       (set-buffer cedet-utest-buffer)
 380       (goto-char (point-max))
 381       (when (not (bolp)) (insert "\n"))
 382       (insert (apply 'format format args))
 383       (insert "\n")
 384       (sit-for 0)
 385       ))
 386   (cedet-utest-show-log-end)
 387   )
 388
 389
 390 (provide 'cedet-utests)
 391
 392 ;;; cedet-utests.el ends here