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