test/cedet/cedet-utests.el

   1 ;;; cedet-utests.el --- Run all unit tests in the CEDET suite.
   2
   3 ;; Copyright (C) 2008, 2009, 2010 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     ;; Pulse
  44     ("pulse interactive test" . (lambda () (pulse-test t)))
  45
  46     ;; Files
  47     ("cedet file conversion" . cedet-files-utest)
  48
  49     ;;
  50     ;; EIEIO
  51     ;;
  52     ("eieio" . (lambda () (let ((lib (locate-library "eieio-tests.el"
  53                                                      t)))
  54                             (load-file lib))))
  55     ("eieio: browser" . eieio-browse)
  56     ("eieio: custom" . (lambda ()
  57                          (require 'eieio-custom)
  58                          (customize-variable 'eieio-widget-test)))
  59     ("eieio: chart" . (lambda ()
  60                         (if (cedet-utest-noninteractive)
  61                             (message " ** Skipping test in noninteractive mode.")
  62                           (chart-test-it-all))))
  63     ;;
  64     ;; EDE
  65     ;;
  66
  67     ;; @todo - Currently handled in the integration tests.  Need
  68     ;;         some simpler unit tests here.
  69
  70     ;;
  71     ;; SEMANTIC
  72     ;;
  73     ("semantic: lex spp table write" . semantic-lex-spp-write-utest)
  74     ("semantic: multi-lang parsing" . semantic-utest-main)
  75     ("semantic: C preprocessor" . semantic-utest-c)
  76     ("semantic: analyzer tests" . semantic-ia-utest)
  77     ("semanticdb: data cache" . semantic-test-data-cache)
  78     ("semantic: throw-on-input" .
  79      (lambda ()
  80        (if (cedet-utest-noninteractive)
  81            (message " ** Skipping test in noninteractive mode.")
  82          (semantic-test-throw-on-input))))
  83
  84     ("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
  85     ;;
  86     ;; SRECODE
  87     ;;
  88     ("srecode: fields" . srecode-field-utest)
  89     ("srecode: templates" . srecode-utest-template-output)
  90     ("srecode: show maps" . srecode-get-maps)
  91     ("srecode: getset" . srecode-utest-getset-output)
  92    )
  93   "Alist of all the tests in CEDET we should run.")
  94
  95 (defvar cedet-running-master-tests nil
  96   "Non-nil when CEDET-utest is running all the tests.")
  97
  98 (defun cedet-utest (&optional exit-on-error)
  99   "Run the CEDET unittests.
 100 EXIT-ON-ERROR causes the test suite to exit on an error, instead
 101 of just logging the error."
 102   (interactive)
 103   (if (or (not (featurep 'semanticdb-mode))
 104           (not (semanticdb-minor-mode-p)))
 105       (error "CEDET Tests require: M-x semantic-load-enable-minimum-features"))
 106   (cedet-utest-log-setup "ALL TESTS")
 107   (let ((tl cedet-utest-test-alist)
 108         (notes nil)
 109         (err nil)
 110         (start (current-time))
 111         (end nil)
 112         (cedet-running-master-tests t)
 113         )
 114     (dolist (T tl)
 115       (cedet-utest-add-log-item-start (car T))
 116       (setq notes nil err nil)
 117       (condition-case Cerr
 118           (progn
 119             (funcall (cdr T))
 120             )
 121         (error
 122          (setq err (format "ERROR: %S" Cerr))
 123          ;;(message "Error caught: %s" Cerr)
 124          ))
 125
 126       ;; Cleanup stray input and events that are in the way.
 127       ;; Not doing this causes sit-for to not refresh the screen.
 128       ;; Doing this causes the user to need to press keys more frequently.
 129       (when (and (interactive-p) (input-pending-p))
 130         (if (fboundp 'read-event)
 131             (read-event)
 132           (read-char)))
 133
 134       (cedet-utest-add-log-item-done notes err)
 135       (when (and exit-on-error err)
 136         (message "to debug this test point, execute:")
 137         (message "%S" (cdr T))
 138         (message "\n ** Exiting Test Suite. ** \n")
 139         (throw 'cedet-utest-exit-on-error t)
 140         )
 141       )
 142     (setq end (current-time))
 143     (cedet-utest-log-shutdown-msg "ALL TESTS" start end)
 144     nil))
 145
 146 (defun cedet-utest-noninteractive ()
 147   "Return non-nil if running non-interactively."
 148   (if (featurep 'xemacs)
 149       (noninteractive)
 150     noninteractive))
 151
 152 ;;;###autoload
 153 (defun cedet-utest-batch ()
 154   "Run the CEDET unit test in BATCH mode."
 155   (unless (cedet-utest-noninteractive)
 156     (error "`cedet-utest-batch' is to be used only with -batch"))
 157   (condition-case err
 158       (when (catch 'cedet-utest-exit-on-error
 159               ;; Get basic semantic features up.
 160               (semantic-load-enable-minimum-features)
 161               ;; Disables all caches related to semantic DB so all
 162               ;; tests run as if we have bootstrapped CEDET for the
 163               ;; first time.
 164               (setq-default semanticdb-new-database-class 'semanticdb-project-database)
 165               (message "Disabling existing Semantic Database Caches.")
 166
 167               ;; Disabling the srecoder map, we won't load a pre-existing one
 168               ;; and will be forced to bootstrap a new one.
 169               (setq srecode-map-save-file nil)
 170
 171               ;; Run the tests
 172               (cedet-utest t)
 173               )
 174         (kill-emacs 1))
 175     (error
 176      (error "Error in unit test harness:\n  %S" err))
 177     )
 178   )
 179
 180 ;;; Logging utility.
 181 ;;
 182 (defvar cedet-utest-frame nil
 183   "Frame used during cedet unit test logging.")
 184 (defvar cedet-utest-buffer nil
 185   "Frame used during cedet unit test logging.")
 186 (defvar cedet-utest-frame-parameters
 187   '((name . "CEDET-UTEST")
 188     (width . 80)
 189     (height . 25)
 190     (minibuffer . t))
 191   "Frame parameters used for the cedet utest log frame.")
 192
 193 (defvar cedet-utest-last-log-item nil
 194   "Remember the last item we were logging for.")
 195
 196 (defvar cedet-utest-log-timer nil
 197   "During a test, track the start time.")
 198
 199 (defun cedet-utest-log-setup (&optional title)
 200   "Setup a frame and buffer for unit testing.
 201 Optional argument TITLE is the title of this testing session."
 202   (setq cedet-utest-log-timer (current-time))
 203   (if (cedet-utest-noninteractive)
 204       (message "\n>> Setting up %s tests to run @ %s\n"
 205                (or title "")
 206                (current-time-string))
 207
 208     ;; Interactive mode needs a frame and buffer.
 209     (when (or (not cedet-utest-frame) (not (frame-live-p cedet-utest-frame)))
 210       (setq cedet-utest-frame (make-frame cedet-utest-frame-parameters)))
 211     (when (or (not cedet-utest-buffer) (not (buffer-live-p cedet-utest-buffer)))
 212       (setq cedet-utest-buffer (get-buffer-create "*CEDET utest log*")))
 213     (save-excursion
 214       (set-buffer cedet-utest-buffer)
 215       (setq cedet-utest-last-log-item nil)
 216       (when (not cedet-running-master-tests)
 217         (erase-buffer))
 218       (insert "\n\nSetting up "
 219               (or title "")
 220               " tests to run @ " (current-time-string) "\n\n"))
 221     (let ((oframe (selected-frame)))
 222       (unwind-protect
 223           (progn
 224             (select-frame cedet-utest-frame)
 225             (switch-to-buffer cedet-utest-buffer t))
 226         (select-frame oframe)))
 227     ))
 228
 229 (defun cedet-utest-elapsed-time (start end)
 230   "Copied from elp.el.  Was elp-elapsed-time.
 231 Argument START and END bound the time being calculated."
 232   (+ (* (- (car end) (car start)) 65536.0)
 233      (- (car (cdr end)) (car (cdr start)))
 234      (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
 235
 236 (defun cedet-utest-log-shutdown (title &optional errorcondition)
 237   "Shut-down a larger test suite.
 238 TITLE is the section that is done.
 239 ERRORCONDITION is some error that may have occurred during testing."
 240   (let ((endtime (current-time))
 241         )
 242     (cedet-utest-log-shutdown-msg title cedet-utest-log-timer endtime)
 243     (setq cedet-utest-log-timer nil)
 244     ))
 245
 246 (defun cedet-utest-log-shutdown-msg (title startime endtime)
 247   "Show a shutdown message with TITLE, STARTIME, and ENDTIME."
 248   (if (cedet-utest-noninteractive)
 249       (progn
 250         (message "\n>> Test Suite %s ended at @ %s"
 251                  title
 252                  (format-time-string "%c" endtime))
 253         (message "     Elapsed Time %.2f Seconds\n"
 254                  (cedet-utest-elapsed-time startime endtime)))
 255
 256     (save-excursion
 257       (set-buffer cedet-utest-buffer)
 258       (goto-char (point-max))
 259       (insert "\n>> Test Suite " title " ended at @ "
 260               (format-time-string "%c" endtime) "\n"
 261               "     Elapsed Time "
 262               (number-to-string
 263                (cedet-utest-elapsed-time startime endtime))
 264               " Seconds\n * "))
 265     ))
 266
 267 (defun cedet-utest-show-log-end ()
 268   "Show the end of the current unit test log."
 269   (unless (cedet-utest-noninteractive)
 270     (let* ((cb (current-buffer))
 271            (cf (selected-frame))
 272            (bw (or (get-buffer-window cedet-utest-buffer t)
 273                    (get-buffer-window (switch-to-buffer cedet-utest-buffer) t)))
 274            (lf (window-frame bw))
 275            )
 276       (select-frame lf)
 277       (select-window bw)
 278       (goto-char (point-max))
 279       (select-frame cf)
 280       (set-buffer cb)
 281       )))
 282
 283 (defun cedet-utest-post-command-hook ()
 284   "Hook run after the current log command was run."
 285     (if (cedet-utest-noninteractive)
 286         (message "")
 287       (save-excursion
 288         (set-buffer cedet-utest-buffer)
 289         (goto-char (point-max))
 290         (insert "\n\n")))
 291     (setq cedet-utest-last-log-item nil)
 292     (remove-hook 'post-command-hook 'cedet-utest-post-command-hook)
 293     )
 294
 295 (defun cedet-utest-add-log-item-start (item)
 296   "Add ITEM into the log as being started."
 297   (unless (equal item cedet-utest-last-log-item)
 298     (setq cedet-utest-last-log-item item)
 299     ;; This next line makes sure we clear out status during logging.
 300     (add-hook 'post-command-hook 'cedet-utest-post-command-hook)
 301
 302     (if (cedet-utest-noninteractive)
 303         (message " - Running %s ..." item)
 304       (save-excursion
 305         (set-buffer cedet-utest-buffer)
 306         (goto-char (point-max))
 307         (when (not (bolp)) (insert "\n"))
 308         (insert "Running " item " ... ")
 309         (sit-for 0)
 310         ))
 311     (cedet-utest-show-log-end)
 312     ))
 313
 314 (defun cedet-utest-add-log-item-done (&optional notes err precr)
 315   "Add into the log that the last item is done.
 316 Apply NOTES to the doneness of the log.
 317 Apply ERR if there was an error in previous item.
 318 Optional argument PRECR indicates to prefix the done msg w/ a newline."
 319   (if (cedet-utest-noninteractive)
 320       ;; Non-interactive-mode - show a message.
 321       (if notes
 322           (message "   * %s {%s}" (or err "done") notes)
 323         (message "   * %s" (or err "done")))
 324     ;; Interactive-mode - insert into the buffer.
 325     (save-excursion
 326       (set-buffer cedet-utest-buffer)
 327       (goto-char (point-max))
 328       (when precr (insert "\n"))
 329       (if err
 330           (insert err)
 331         (insert "done")
 332         (when notes (insert " (" notes ")")))
 333       (insert "\n")
 334       (setq cedet-utest-last-log-item nil)
 335       (sit-for 0)
 336       )))
 337
 338 ;;; INDIVIDUAL TEST API
 339 ;;
 340 ;; Use these APIs to start and log information.
 341 ;;
 342 ;; The other fcns will be used to log across all the tests at once.
 343 (defun cedet-utest-log-start (testname)
 344   "Setup the log for the test TESTNAME."
 345   ;; Make sure we have a log buffer.
 346   (save-window-excursion
 347     (when (or (not cedet-utest-buffer)
 348               (not (buffer-live-p cedet-utest-buffer))
 349               (not (get-buffer-window cedet-utest-buffer t))
 350               )
 351       (cedet-utest-log-setup))
 352     ;; Add our startup message.
 353     (cedet-utest-add-log-item-start testname)
 354     ))
 355
 356 (defun cedet-utest-log(format &rest args)
 357   "Log the text string FORMAT.
 358 The rest of the ARGS are used to fill in FORMAT with `format'."
 359   (if (cedet-utest-noninteractive)
 360       (apply 'message format args)
 361     (save-excursion
 362       (set-buffer cedet-utest-buffer)
 363       (goto-char (point-max))
 364       (when (not (bolp)) (insert "\n"))
 365       (insert (apply 'format format args))
 366       (insert "\n")
 367       (sit-for 0)
 368       ))
 369   (cedet-utest-show-log-end)
 370   )
 371
 372 ;;; Inversion tests
 373
 374 (defun inversion-unit-test ()
 375   "Test inversion to make sure it can identify different version strings."
 376   (interactive)
 377   (let ((c1 (inversion-package-version 'inversion))
 378         (c1i (inversion-package-incompatibility-version 'inversion))
 379         (c2 (inversion-decode-version  "1.3alpha2"))
 380         (c3 (inversion-decode-version  "1.3beta4"))
 381         (c4 (inversion-decode-version  "1.3 beta5"))
 382         (c5 (inversion-decode-version  "1.3.4"))
 383         (c6 (inversion-decode-version  "2.3alpha"))
 384         (c7 (inversion-decode-version  "1.3"))
 385         (c8 (inversion-decode-version  "1.3pre1"))
 386         (c9 (inversion-decode-version  "2.4 (patch 2)"))
 387         (c10 (inversion-decode-version "2.4 (patch 3)"))
 388         (c11 (inversion-decode-version "2.4.2.1"))
 389         (c12 (inversion-decode-version "2.4.2.2"))
 390         )
 391     (if (not (and
 392               (inversion-= c1 c1)
 393               (inversion-< c1i c1)
 394               (inversion-< c2 c3)
 395               (inversion-< c3 c4)
 396               (inversion-< c4 c5)
 397               (inversion-< c5 c6)
 398               (inversion-< c2 c4)
 399               (inversion-< c2 c5)
 400               (inversion-< c2 c6)
 401               (inversion-< c3 c5)
 402               (inversion-< c3 c6)
 403               (inversion-< c7 c6)
 404               (inversion-< c4 c7)
 405               (inversion-< c2 c7)
 406               (inversion-< c8 c6)
 407               (inversion-< c8 c7)
 408               (inversion-< c4 c8)
 409               (inversion-< c2 c8)
 410               (inversion-< c9 c10)
 411               (inversion-< c10 c11)
 412               (inversion-< c11 c12)
 413               ;; Negatives
 414               (not (inversion-< c3 c2))
 415               (not (inversion-< c4 c3))
 416               (not (inversion-< c5 c4))
 417               (not (inversion-< c6 c5))
 418               (not (inversion-< c7 c2))
 419               (not (inversion-< c7 c8))
 420               (not (inversion-< c12 c11))
 421               ;; Test the tester on inversion
 422               (not (inversion-test 'inversion inversion-version))
 423               ;; Test that we throw an error
 424               (inversion-test 'inversion "0.0.0")
 425               (inversion-test 'inversion "1000.0")
 426               ))
 427         (error "Inversion tests failed")
 428       (message "Inversion tests passed."))))
 429
 430 ;;; cedet-files unit test
 431
 432 (defvar cedet-files-utest-list
 433   '(
 434     ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
 435     ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
 436     ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
 437     ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
 438     )
 439   "List of different file names to test.
 440 Each entry is a cons cell of ( FNAME . CONVERTED )
 441 where FNAME is some file name, and CONVERTED is what it should be
 442 converted into.")
 443
 444 (defun cedet-files-utest ()
 445   "Test out some file name conversions."
 446   (interactive)
 447   (let ((idx 0))
 448     (dolist (FT cedet-files-utest-list)
 449
 450       (setq idx (+ idx 1))
 451
 452       (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
 453             (file->dir (cedet-file-name-to-directory-name (cdr FT) t))
 454             )
 455
 456         (unless (string= (cdr FT) dir->file)
 457           (error "Failed: %d.  Found: %S Wanted: %S"
 458                  idx dir->file (cdr FT))
 459           )
 460
 461         (unless (string= file->dir (car FT))
 462           (error "Failed: %d.  Found: %S Wanted: %S"
 463                  idx file->dir (car FT)))))))
 464
 465 ;;; pulse test
 466
 467 (defun pulse-test (&optional no-error)
 468   "Test the lightening function for pulsing a line.
 469 When optional NO-ERROR don't throw an error if we can't run tests."
 470   (interactive)
 471   (if (or (not pulse-flag) (not (pulse-available-p)))
 472       (if no-error
 473           nil
 474         (error (concat "Pulse test only works on versions of Emacs"
 475                        " that support pulsing")))
 476     ;; Run the tests
 477     (when (interactive-p)
 478       (message "<Press a key> Pulse one line.")
 479       (read-char))
 480     (pulse-momentary-highlight-one-line (point))
 481     (when (interactive-p)
 482       (message "<Press a key> Pulse a region.")
 483       (read-char))
 484     (pulse-momentary-highlight-region (point)
 485                                       (save-excursion
 486                                         (condition-case nil
 487                                             (forward-char 30)
 488                                           (error nil))
 489                                         (point)))
 490     (when (interactive-p)
 491       (message "<Press a key> Pulse line a specific color.")
 492       (read-char))
 493     (pulse-momentary-highlight-one-line (point) 'modeline)
 494     (when (interactive-p)
 495       (message "<Press a key> Pulse a pre-existing overlay.")
 496       (read-char))
 497     (let* ((start (point-at-bol))
 498            (end (save-excursion
 499                   (end-of-line)
 500                   (when (not (eobp))
 501                     (forward-char 1))
 502                   (point)))
 503            (o (make-overlay start end))
 504            )
 505       (pulse-momentary-highlight-overlay o)
 506       (if (overlay-buffer o)
 507           (delete-overlay o)
 508         (error "Non-temporary overlay was deleted!"))
 509       )
 510     (when (interactive-p)
 511       (message "Done!"))))
 512
 513 (provide 'cedet-utests)
 514
 515 ;; arch-tag: ace16290-4119-4df0-b33c-8c6b809f420d
 516 ;;; cedet-utests.el ends here