Mercurial > hg > xemacs-beta
comparison tests/automated/test-harness.el @ 1719:d9c4b6e360d8
[xemacs-hg @ 2003-09-27 06:51:16 by stephent]
uglify test suite <87oex67mk9.fsf@tleepslib.sk.tsukuba.ac.jp>
author | stephent |
---|---|
date | Sat, 27 Sep 2003 06:51:19 +0000 |
parents | adcbad629af5 |
children | 58c2d4f889be |
comparison
equal
deleted
inserted
replaced
1718:199a2d7fb766 | 1719:d9c4b6e360d8 |
---|---|
45 (require 'bytecomp) | 45 (require 'bytecomp) |
46 | 46 |
47 (defvar test-harness-verbose | 47 (defvar test-harness-verbose |
48 (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) | 48 (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) |
49 "*Non-nil means print messages describing progress of emacs-tester.") | 49 "*Non-nil means print messages describing progress of emacs-tester.") |
50 | |
51 (defvar test-harness-file-results-alist nil | |
52 "Each element is a list (FILE SUCCESSES TESTS). | |
53 The order is the reverse of the order in which tests are run. | |
54 | |
55 FILE is a string naming the test file. | |
56 SUCCESSES is a non-negative integer, the number of successes. | |
57 TESTS is a non-negative integer, the number of tests run.") | |
50 | 58 |
51 (defvar test-harness-risk-infloops nil | 59 (defvar test-harness-risk-infloops nil |
52 "*Non-nil to run tests that may loop infinitely in buggy implementations.") | 60 "*Non-nil to run tests that may loop infinitely in buggy implementations.") |
53 | 61 |
54 (defvar test-harness-current-file nil) | 62 (defvar test-harness-current-file nil) |
342 (when (> (length reasons) 1) | 350 (when (> (length reasons) 1) |
343 (setq summary-msg (concat summary-msg reasons " | 351 (setq summary-msg (concat summary-msg reasons " |
344 Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH | 352 Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH |
345 to the package hierarchy root or configure with --package-path to enable | 353 to the package hierarchy root or configure with --package-path to enable |
346 the skipped tests."))) | 354 the skipped tests."))) |
355 (setq test-harness-file-results-alist | |
356 (cons (list filename passes total) | |
357 test-harness-file-results-alist)) | |
347 (message "%s" summary-msg)) | 358 (message "%s" summary-msg)) |
348 (when unexpected-test-suite-failure | 359 (when unexpected-test-suite-failure |
349 (message "Test suite execution failed unexpectedly.")) | 360 (message "Test suite execution failed unexpectedly.")) |
350 (fmakunbound 'Assert) | 361 (fmakunbound 'Assert) |
351 (fmakunbound 'Check-Error) | 362 (fmakunbound 'Check-Error) |
352 (fmakunbound 'Check-Message) | 363 (fmakunbound 'Check-Message) |
353 (fmakunbound 'Check-Error-Message) | 364 (fmakunbound 'Check-Error-Message) |
354 (fmakunbound 'Ignore-Ebola) | 365 (fmakunbound 'Ignore-Ebola) |
355 (fmakunbound 'Int-to-Marker) | 366 (fmakunbound 'Int-to-Marker) |
367 (and noninteractive | |
368 (message "%s" (buffer-substring-no-properties | |
369 nil nil "*Test-Log*")))))) | |
356 ))) | 370 ))) |
357 | 371 |
358 (defvar test-harness-results-point-max nil) | 372 (defvar test-harness-results-point-max nil) |
359 (defmacro displaying-emacs-test-results (&rest body) | 373 (defmacro displaying-emacs-test-results (&rest body) |
360 `(let ((test-harness-results-point-max test-harness-results-point-max)) | 374 `(let ((test-harness-results-point-max test-harness-results-point-max)) |
430 "test-harness.el")))) | 444 "test-harness.el")))) |
431 (or (batch-test-emacs-1 file-in-dir) | 445 (or (batch-test-emacs-1 file-in-dir) |
432 (setq error t)))) | 446 (setq error t)))) |
433 (or (batch-test-emacs-1 file) | 447 (or (batch-test-emacs-1 file) |
434 (setq error t)))) | 448 (setq error t)))) |
435 (message "Done") | 449 (let ((namelen 0) |
450 (succlen 0) | |
451 (testlen 0) | |
452 (results test-harness-file-results-alist)) | |
453 ;; compute maximum lengths of variable components of report | |
454 ;; probably should just use (length "byte-compiler-tests.el") | |
455 ;; and 5-place sizes -- this will also work for the file-by-file | |
456 ;; printing when Adrian's kludge gets reverted | |
457 (flet ((print-width (i) | |
458 (let ((x 10) (y 1)) | |
459 (while (>= i x) | |
460 (setq x (* 10 x) y (1+ y))) | |
461 y))) | |
462 (while results | |
463 (let* ((head (car results)) | |
464 (nn (length (file-name-nondirectory (first head)))) | |
465 (ss (print-width (second head))) | |
466 (tt (print-width (third head)))) | |
467 (when (> nn namelen) (setq namelen nn)) | |
468 (when (> ss succlen) (setq succlen ss)) | |
469 (when (> tt testlen) (setq testlen tt))) | |
470 (setq results (cdr results)))) | |
471 ;; create format and print | |
472 (let ((template | |
473 (format "%%-%ds %%%dd of %%%dd tests successful (%%d%%%%)" | |
474 (1+ namelen) succlen testlen)) | |
475 (results (reverse test-harness-file-results-alist))) | |
476 (while results | |
477 (let* ((head (car results)) | |
478 (fname (file-name-nondirectory (first head))) | |
479 (nsucc (second head)) | |
480 (ntest (third head))) | |
481 (message template | |
482 (concat fname ":") | |
483 nsucc | |
484 ntest | |
485 (/ (* 100 nsucc) ntest)) | |
486 (setq results (cdr results)))))) | |
487 (message "\nDone") | |
436 (kill-emacs (if error 1 0)))) | 488 (kill-emacs (if error 1 0)))) |
437 | 489 |
438 (provide 'test-harness) | 490 (provide 'test-harness) |
439 | 491 |
440 ;;; test-harness.el ends here | 492 ;;; test-harness.el ends here |