Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 4962:e813cf16c015

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 01 Feb 2010 05:29:05 -0600
parents db2db229ee82 6ef8256a020a
children 3daf9fc57cd4
comparison
equal deleted inserted replaced
4961:b90f8cf474e0 4962:e813cf16c015
112 112
113 (defconst test-harness-null-summary-template 113 (defconst test-harness-null-summary-template
114 (format "%%-%ds No tests run." 114 (format "%%-%ds No tests run."
115 (length "byte-compiler-tests.el:")) ; use the longest file name 115 (length "byte-compiler-tests.el:")) ; use the longest file name
116 "Format for \"No tests\" lines printed after a file is run.") 116 "Format for \"No tests\" lines printed after a file is run.")
117
118 (defconst test-harness-aborted-summary-template
119 (format "%%-%ds %%%dd tests completed (aborted)."
120 (length "byte-compiler-tests.el:") ; use the longest file name
121 5)
122 "Format for summary lines printed after a test run on a file was aborted.")
117 123
118 ;;;###autoload 124 ;;;###autoload
119 (defun test-emacs-test-file (filename) 125 (defun test-emacs-test-file (filename)
120 "Test a file of Lisp code named FILENAME. 126 "Test a file of Lisp code named FILENAME.
121 The output file's name is made by appending `c' to the end of FILENAME." 127 The output file's name is made by appending `c' to the end of FILENAME."
336 particular failure; any value given here will be concatenated with a phrase 342 particular failure; any value given here will be concatenated with a phrase
337 describing the expected and actual values of the comparison. Optional 343 describing the expected and actual values of the comparison. Optional
338 DESCRIPTION describes the assertion; by default, the unevalated comparison 344 DESCRIPTION describes the assertion; by default, the unevalated comparison
339 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert 345 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
340 is used in a loop." 346 is used in a loop."
341 (let* ((assertion `(,test ,testval ,expected)) 347 (let* ((assertion `(not (,test ,testval ,expected)))
342 (failmsg `(format "%S shouldn't be `%s' to %S but is" 348 (failmsg `(format "%S shouldn't be `%s' to %S but is"
343 ,testval ',test ,expected)) 349 ,testval ',test ,expected))
344 (failmsg2 (if failing-case `(concat 350 (failmsg2 (if failing-case `(concat
345 (format "%S, " ,failing-case) 351 (format "%S, " ,failing-case)
346 ,failmsg) 352 ,failmsg)
347 failmsg))) 353 failmsg)))
348 `(Assert ,assertion ,failmsg2 ,description))) 354 `(Assert ,assertion ,failmsg2 ,description)))
349 355
350 (defmacro Assert-eq (testval expected &optional failing-case description) 356 ;; Specific versions of `Assert-test'. These are just convenience
351 "Test passes if TESTVAL is 'eq' to EXPECTED. 357 ;; functions, functioning identically to `Assert-test', and duplicating
352 Optional FAILING-CASE describes the particular failure; any value given 358 ;; the doc string for each would be too annoying.
353 here will be concatenated with a phrase describing the expected and actual 359 (defmacro Assert-eq (testval expected &optional failing-case
354 values of the comparison. Optional DESCRIPTION describes the assertion; by 360 description)
355 default, the unevalated comparison expressions are given. FAILING-CASE and
356 DESCRIPTION are useful when Assert is used in a loop."
357 `(Assert-test eq ,testval ,expected ,failing-case ,description)) 361 `(Assert-test eq ,testval ,expected ,failing-case ,description))
358 362 (defmacro Assert-eql (testval expected &optional failing-case
359 (defmacro Assert-eql (testval expected &optional failing-case description) 363 description)
360 "Test passes if TESTVAL is 'eql' to EXPECTED.
361 Optional FAILING-CASE describes the particular failure; any value given
362 here will be concatenated with a phrase describing the expected and actual
363 values of the comparison. Optional DESCRIPTION describes the assertion; by
364 default, the unevalated comparison expressions are given. FAILING-CASE and
365 DESCRIPTION are useful when Assert is used in a loop."
366 `(Assert-test eql ,testval ,expected ,failing-case ,description)) 364 `(Assert-test eql ,testval ,expected ,failing-case ,description))
367
368 (defmacro Assert-equal (testval expected &optional failing-case 365 (defmacro Assert-equal (testval expected &optional failing-case
369 description) 366 description)
370 "Test passes if TESTVAL is 'equal' to EXPECTED.
371 Optional FAILING-CASE describes the particular failure; any value given
372 here will be concatenated with a phrase describing the expected and actual
373 values of the comparison. Optional DESCRIPTION describes the assertion; by
374 default, the unevalated comparison expressions are given. FAILING-CASE and
375 DESCRIPTION are useful when Assert is used in a loop."
376 `(Assert-test equal ,testval ,expected ,failing-case ,description)) 367 `(Assert-test equal ,testval ,expected ,failing-case ,description))
377
378 (defmacro Assert-equalp (testval expected &optional failing-case 368 (defmacro Assert-equalp (testval expected &optional failing-case
379 description) 369 description)
380 "Test passes if TESTVAL is 'equalp' to EXPECTED.
381 Optional FAILING-CASE describes the particular failure; any value given
382 here will be concatenated with a phrase describing the expected and actual
383 values of the comparison. Optional DESCRIPTION describes the assertion; by
384 default, the unevalated comparison expressions are given. FAILING-CASE and
385 DESCRIPTION are useful when Assert is used in a loop."
386 `(Assert-test equalp ,testval ,expected ,failing-case ,description)) 370 `(Assert-test equalp ,testval ,expected ,failing-case ,description))
387
388 (defmacro Assert-string= (testval expected &optional failing-case 371 (defmacro Assert-string= (testval expected &optional failing-case
389 description) 372 description)
390 "Test passes if TESTVAL is 'string=' to EXPECTED.
391 Optional FAILING-CASE describes the particular failure; any value given
392 here will be concatenated with a phrase describing the expected and actual
393 values of the comparison. Optional DESCRIPTION describes the assertion; by
394 default, the unevalated comparison expressions are given. FAILING-CASE and
395 DESCRIPTION are useful when Assert is used in a loop."
396 `(Assert-test string= ,testval ,expected ,failing-case ,description)) 373 `(Assert-test string= ,testval ,expected ,failing-case ,description))
397 374 (defmacro Assert= (testval expected &optional failing-case
398 (defmacro Assert= (testval expected &optional failing-case description) 375 description)
399 "Test passes if TESTVAL is '=' to EXPECTED.
400 Optional FAILING-CASE describes the particular failure; any value given
401 here will be concatenated with a phrase describing the expected and actual
402 values of the comparison. Optional DESCRIPTION describes the assertion; by
403 default, the unevalated comparison expressions are given. FAILING-CASE and
404 DESCRIPTION are useful when Assert is used in a loop."
405 `(Assert-test = ,testval ,expected ,failing-case ,description)) 376 `(Assert-test = ,testval ,expected ,failing-case ,description))
406 377 (defmacro Assert<= (testval expected &optional failing-case
407 (defmacro Assert<= (testval expected &optional failing-case description) 378 description)
408 "Test passes if TESTVAL is '<=' to EXPECTED.
409 Optional FAILING-CASE describes the particular failure; any value given
410 here will be concatenated with a phrase describing the expected and actual
411 values of the comparison. Optional DESCRIPTION describes the assertion; by
412 default, the unevalated comparison expressions are given. FAILING-CASE and
413 DESCRIPTION are useful when Assert is used in a loop."
414 `(Assert-test <= ,testval ,expected ,failing-case ,description)) 379 `(Assert-test <= ,testval ,expected ,failing-case ,description))
380
381 ;; Specific versions of `Assert-test-not'. These are just convenience
382 ;; functions, functioning identically to `Assert-test-not', and
383 ;; duplicating the doc string for each would be too annoying.
384 (defmacro Assert-not-eq (testval expected &optional failing-case
385 description)
386 `(Assert-test-not eq ,testval ,expected ,failing-case ,description))
387 (defmacro Assert-not-eql (testval expected &optional failing-case
388 description)
389 `(Assert-test-not eql ,testval ,expected ,failing-case ,description))
390 (defmacro Assert-not-equal (testval expected &optional failing-case
391 description)
392 `(Assert-test-not equal ,testval ,expected ,failing-case ,description))
393 (defmacro Assert-not-equalp (testval expected &optional failing-case
394 description)
395 `(Assert-test-not equalp ,testval ,expected ,failing-case ,description))
396 (defmacro Assert-not-string= (testval expected &optional failing-case
397 description)
398 `(Assert-test-not string= ,testval ,expected ,failing-case ,description))
399 (defmacro Assert-not= (testval expected &optional failing-case
400 description)
401 `(Assert-test-not = ,testval ,expected ,failing-case ,description))
415 402
416 (defmacro Check-Error (expected-error &rest body) 403 (defmacro Check-Error (expected-error &rest body)
417 (let ((quoted-body (if (= 1 (length body)) 404 (let ((quoted-body (if (= 1 (length body))
418 `(quote ,(car body)) `(quote (progn ,@body))))) 405 `(quote ,(car body)) `(quote (progn ,@body)))))
419 `(condition-case error-info 406 `(condition-case error-info
515 (error 502 (error
516 (incf unexpected-test-file-failures) 503 (incf unexpected-test-file-failures)
517 (princ (format "Unexpected error %S while executing interpreted code\n" 504 (princ (format "Unexpected error %S while executing interpreted code\n"
518 error-info)) 505 error-info))
519 (message "Unexpected error %S while executing interpreted code." error-info) 506 (message "Unexpected error %S while executing interpreted code." error-info)
520 (message "Test suite execution aborted." error-info) 507 (message "Test suite execution aborted.")
521 )) 508 ))
522 (princ "\nTesting Compiled Lisp\n\n") 509 (princ "\nTesting Compiled Lisp\n\n")
523 (let (code 510 (let (code
524 (test-harness-test-compiled t)) 511 (test-harness-test-compiled t))
525 (condition-case error-info 512 (condition-case error-info
536 (error 523 (error
537 (incf unexpected-test-file-failures) 524 (incf unexpected-test-file-failures)
538 (princ (format "Unexpected error %S while executing byte-compiled code\n" 525 (princ (format "Unexpected error %S while executing byte-compiled code\n"
539 error-info)) 526 error-info))
540 (message "Unexpected error %S while executing byte-compiled code." error-info) 527 (message "Unexpected error %S while executing byte-compiled code." error-info)
541 (message "Test suite execution aborted." error-info) 528 (message "Test suite execution aborted.")
542 ))) 529 )))
543 (princ (format "\nSUMMARY for %s:\n" filename)) 530 (princ (format "\nSUMMARY for %s:\n" filename))
544 (princ (format "\t%5d passes\n" passes)) 531 (princ (format "\t%5d passes\n" passes))
545 (princ (format "\t%5d assertion failures\n" assertion-failures)) 532 (princ (format "\t%5d assertion failures\n" assertion-failures))
546 (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures)) 533 (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures))
553 wrong-error-failures 540 wrong-error-failures
554 missing-message-failures 541 missing-message-failures
555 other-failures)) 542 other-failures))
556 (basename (file-name-nondirectory filename)) 543 (basename (file-name-nondirectory filename))
557 (summary-msg 544 (summary-msg
558 (if (> total 0) 545 (cond ((> unexpected-test-file-failures 0)
559 (format test-harness-file-summary-template 546 (format test-harness-aborted-summary-template
560 (concat basename ":") 547 (concat basename ":") total))
561 passes total (/ (* 100 passes) total)) 548 ((> total 0)
562 (format test-harness-null-summary-template 549 (format test-harness-file-summary-template
563 (concat basename ":")))) 550 (concat basename ":")
551 passes total (/ (* 100 passes) total)))
552 (t
553 (format test-harness-null-summary-template
554 (concat basename ":")))))
564 (reasons "")) 555 (reasons ""))
565 (maphash (lambda (key value) 556 (maphash (lambda (key value)
566 (setq reasons 557 (setq reasons
567 (concat reasons 558 (concat reasons
568 (format "\n %d tests skipped because %s." 559 (format "\n %d tests skipped because %s."
701 (while results 692 (while results
702 (let* ((head (car results)) 693 (let* ((head (car results))
703 (basename (file-name-nondirectory (first head))) 694 (basename (file-name-nondirectory (first head)))
704 (nsucc (second head)) 695 (nsucc (second head))
705 (ntest (third head))) 696 (ntest (third head)))
706 (if (> ntest 0) 697 (cond ((member (first head) unexpected-test-suite-failure-files)
707 (message test-harness-file-summary-template 698 (message test-harness-aborted-summary-template
708 (concat basename ":") 699 (concat basename ":")
709 nsucc 700 ntest))
710 ntest 701 ((> ntest 0)
711 (/ (* 100 nsucc) ntest)) 702 (message test-harness-file-summary-template
712 (message test-harness-null-summary-template 703 (concat basename ":")
713 (concat basename ":"))) 704 nsucc
705 ntest
706 (/ (* 100 nsucc) ntest)))
707 (t
708 (message test-harness-null-summary-template
709 (concat basename ":"))))
714 (setq results (cdr results))))) 710 (setq results (cdr results)))))
715 (when (> unexpected-test-suite-failures 0) 711 (when (> unexpected-test-suite-failures 0)
716 (message "\n***** There %s %d unexpected test suite %s in %s:" 712 (message "\n***** There %s %d unexpected test suite %s in %s:"
717 (if (= unexpected-test-suite-failures 1) "was" "were") 713 (if (= unexpected-test-suite-failures 1) "was" "were")
718 unexpected-test-suite-failures 714 unexpected-test-suite-failures