Mercurial > emacs
annotate test/cedet/cedet-utests.el @ 108357:fb410336248f
Remove --- and +++ lines from NEWS file.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 25 Apr 2010 18:09:52 -0400 |
parents | 5df8e547a422 |
children | 376148b31b5e |
rev | line source |
---|---|
105267 | 1 ;;; cedet-utests.el --- Run all unit tests in the CEDET suite. |
2 | |
106815 | 3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
105267 | 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. | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
239 ERRORCONDITION is some error that may have occurred during testing." |
105267 | 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. | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
469 When optional NO-ERROR don't throw an error if we can't run tests." |
105267 | 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 | |
105377 | 515 ;; arch-tag: ace16290-4119-4df0-b33c-8c6b809f420d |
105267 | 516 ;;; cedet-utests.el ends here |