Commit | Line | Data |
---|---|---|
74ea13c1 CY |
1 | ;;; cedet-utests.el --- Run all unit tests in the CEDET suite. |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2008-2014 Free Software Foundation, Inc. |
74ea13c1 CY |
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) | |
ee7683eb | 99 | "Run the CEDET unit tests. |
74ea13c1 CY |
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. | |
d1f18ec0 | 239 | ERRORCONDITION is some error that may have occurred during testing." |
74ea13c1 CY |
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. | |
d1f18ec0 | 469 | When optional NO-ERROR don't throw an error if we can't run tests." |
74ea13c1 CY |
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 | ;;; cedet-utests.el ends here |