Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 1751:5a9a66ba67ca

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-10-15 08:56:35 by stephent] test beautification <87vfqq6ftf.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Wed, 15 Oct 2003 08:56:39 +0000
parents c04bc2b126ef
children 90502933fb98
comparison
equal deleted inserted replaced
1750:7580e52a8218 1751:5a9a66ba67ca
1 ;; test-harness.el --- Run Emacs Lisp test suites. 1 ;; test-harness.el --- Run Emacs Lisp test suites.
2 2
3 ;;; Copyright (C) 1998 Free Software Foundation, Inc. 3 ;;; Copyright (C) 1998, 2002, 2003 Free Software Foundation, Inc.
4 ;;; Copyright (C) 2002 Ben Wing. 4 ;;; Copyright (C) 2002 Ben Wing.
5 5
6 ;; Author: Martin Buchholz 6 ;; Author: Martin Buchholz
7 ;; Keywords: testing 7 ;; Keywords: testing
8 8
61 61
62 (defvar test-harness-current-file nil) 62 (defvar test-harness-current-file nil)
63 63
64 (defvar emacs-lisp-file-regexp (purecopy "\\.el\\'") 64 (defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
65 "*Regexp which matches Emacs Lisp source files.") 65 "*Regexp which matches Emacs Lisp source files.")
66
67 (defconst test-harness-file-summary-template
68 (format "%%-%ds %%%dd of %%%dd tests successful (%%3d%%%%)."
69 (length "byte-compiler-tests.el:") ; use the longest file name
70 5
71 5)
72 "Format for summary lines printed after each file is run.")
73
74 (defconst test-harness-null-summary-template
75 (format "%%-%ds No tests run."
76 (length "byte-compiler-tests.el:")) ; use the longest file name
77 "Format for \"No tests\" lines printed after a file is run.")
66 78
67 ;;;###autoload 79 ;;;###autoload
68 (defun test-emacs-test-file (filename) 80 (defun test-emacs-test-file (filename)
69 "Test a file of Lisp code named FILENAME. 81 "Test a file of Lisp code named FILENAME.
70 The output file's name is made by appending `c' to the end of FILENAME." 82 The output file's name is made by appending `c' to the end of FILENAME."
116 (condition-case error-info 128 (condition-case error-info
117 (while t 129 (while t
118 (setq body (cons (read buffer) body))) 130 (setq body (cons (read buffer) body)))
119 (end-of-file nil) 131 (end-of-file nil)
120 (error 132 (error
121 (princ (format "Unexpected error %S reading forms from buffer\n" error-info)))) 133 (princ (format "Unexpected error %S reading forms from buffer\n"
134 error-info))))
122 `(lambda () 135 `(lambda ()
123 (defvar passes) 136 (defvar passes)
124 (defvar assertion-failures) 137 (defvar assertion-failures)
125 (defvar no-error-failures) 138 (defvar no-error-failures)
126 (defvar wrong-error-failures) 139 (defvar wrong-error-failures)
335 missing-message-failures 348 missing-message-failures
336 other-failures)) 349 other-failures))
337 (basename (file-name-nondirectory filename)) 350 (basename (file-name-nondirectory filename))
338 (summary-msg 351 (summary-msg
339 (if (> total 0) 352 (if (> total 0)
340 (format "%s: %d of %d tests successful (%d%%)." 353 (format test-harness-file-summary-template
341 basename passes total (/ (* 100 passes) total)) 354 (concat basename ":")
342 (format "%s: No tests run" basename))) 355 passes total (/ (* 100 passes) total))
356 (format test-harness-null-summary-template
357 (concat basename ":"))))
343 (reasons "")) 358 (reasons ""))
344 (maphash (lambda (key value) 359 (maphash (lambda (key value)
345 (setq reasons 360 (setq reasons
346 (concat reasons 361 (concat reasons
347 (format "\n %d tests skipped because %s." 362 (format "\n %d tests skipped because %s."
364 (fmakunbound 'Check-Error-Message) 379 (fmakunbound 'Check-Error-Message)
365 (fmakunbound 'Ignore-Ebola) 380 (fmakunbound 'Ignore-Ebola)
366 (fmakunbound 'Int-to-Marker) 381 (fmakunbound 'Int-to-Marker)
367 (and noninteractive 382 (and noninteractive
368 (message "%s" (buffer-substring-no-properties 383 (message "%s" (buffer-substring-no-properties
369 nil nil "*Test-Log*")))))) 384 nil nil "*Test-Log*")))
385 )))
370 386
371 (defvar test-harness-results-point-max nil) 387 (defvar test-harness-results-point-max nil)
372 (defmacro displaying-emacs-test-results (&rest body) 388 (defmacro displaying-emacs-test-results (&rest body)
373 `(let ((test-harness-results-point-max test-harness-results-point-max)) 389 `(let ((test-harness-results-point-max test-harness-results-point-max))
374 ;; Log the file name. 390 ;; Log the file name.
466 (when (> nn namelen) (setq namelen nn)) 482 (when (> nn namelen) (setq namelen nn))
467 (when (> ss succlen) (setq succlen ss)) 483 (when (> ss succlen) (setq succlen ss))
468 (when (> tt testlen) (setq testlen tt))) 484 (when (> tt testlen) (setq testlen tt)))
469 (setq results (cdr results)))) 485 (setq results (cdr results))))
470 ;; create format and print 486 ;; create format and print
471 (let ((template 487 (let ((results (reverse test-harness-file-results-alist)))
472 (format "%%-%ds %%%dd of %%%dd tests successful (%%d%%%%)"
473 (1+ namelen) succlen testlen))
474 (results (reverse test-harness-file-results-alist)))
475 (while results 488 (while results
476 (let* ((head (car results)) 489 (let* ((head (car results))
477 (fname (file-name-nondirectory (first head))) 490 (basename (file-name-nondirectory (first head)))
478 (nsucc (second head)) 491 (nsucc (second head))
479 (ntest (third head))) 492 (ntest (third head)))
480 (if (> ntest 0) 493 (if (> ntest 0)
481 (message template 494 (message test-harness-file-summary-template
482 (concat fname ":") 495 (concat basename ":")
483 nsucc 496 nsucc
484 ntest 497 ntest
485 (/ (* 100 nsucc) ntest)) 498 (/ (* 100 nsucc) ntest))
486 (message "%s: No tests run\n" fname)) 499 (message test-harness-null-summary-template
500 (concat basename ":")))
487 (setq results (cdr results)))))) 501 (setq results (cdr results))))))
488 (message "\nDone") 502 (message "\nDone")
489 (kill-emacs (if error 1 0)))) 503 (kill-emacs (if error 1 0))))
490 504
491 (provide 'test-harness) 505 (provide 'test-harness)