From f849f4dba02f2b41d78ffe21d43be5b184aa7cdf Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sun, 22 Dec 2013 23:06:58 -0800 Subject: [PATCH] Simple test script to run all of the tests in the tests directory. --- tests/run-tests.lisp | 96 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 tests/run-tests.lisp diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp new file mode 100644 index 000000000..0a7da54b2 --- /dev/null +++ b/tests/run-tests.lisp @@ -0,0 +1,96 @@ +;;;; -*- Mode: lisp -*- + +;;;; Main script to run all of the tests in the tests directory. +;;;; It is intended to be run using something like +;;;; +;;;; lisp -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)' +;;;; +;;;; The exit code indicates whether there were any test failures. A +;;;; non-zero code indicates a failure of some sort. +;;;; +;;;; It is assumed that either asdf or quicklisp is set up +;;;; appropriately so that lisp-unit can be automatically loaded + +(defpackage :cmucl-test-runner + (:use :cl) + (:export #:run-all-tests + #:load-and-run-all-tests + #:print-test-results)) + +(in-package :cmucl-test-runner) + +(require :lisp-unit) + +;; Be rather verbose in printing the tests +(setf lisp-unit:*print-summary* t) +(setf lisp-unit:*print-failures* t) +(setf lisp-unit:*print-errors* t) + +(defvar *load-path* *load-pathname*) + +;; Look through all the files in the tests directory and load them. +;; Then run all of the tests. For each file, it ia assumed that a +;; package is created that is named with "-TESTS" appended to he +;; pathname-name of the file. +(defun load-and-run-all-tests () + (let (test-names + test-results) + (dolist (file (directory "tests/*.lisp")) + (unless (equal file *load-path*) + (let ((basename (pathname-name file))) + ;; Create the package name from the pathname name so we know + ;; how to run the test. + (push (concatenate 'string (string-upcase basename) "-TESTS") + test-names) + (load file)))) + (setf test-names (nreverse test-names)) + (dolist (test test-names) + (push (lisp-unit:run-tests :all test) + test-results)) + (nreverse test-results))) + +(defun print-test-results (results) + (let ((passed 0) + (failed 0) + (execute-errors 0) + failed-tests + execute-error-tests) + (dolist (result results) + (incf passed (lisp-unit::pass result)) + (incf failed (lisp-unit::fail result)) + (incf execute-errors (lisp-unit::exerr result)) + (when (lisp-unit::failed-tests result) + (setf failed-tests + (append (lisp-unit::failed-tests result) + failed-tests))) + (when (lisp-unit::error-tests result) + (setf execute-error-tests + (append (lisp-unit::error-tests result) + execute-error-tests)))) + (format t "~2&-------------------------------------------------~%") + (format t "Summary of all testsuites~2%") + (format t "~D testsuites were run~%" (length results)) + (format t " ~5D tests total~%" (+ passed failed execute-errors)) + (format t " ~5D tests failed~%" failed) + (format t " ~5D tests with execution errors~%" execute-errors) + (format t "~5,2f% of the tests passed~%" + (float (* 100 + (- 1 (/ (+ failed execute-errors) + (+ passed failed execute-errors)))))) + ;; Print some info about any failed tests. Then exit. We want to + ;; set the exit code so that any scripts runnning this can + ;; determine if there were any test failures. + (cond ((plusp (+ failed execute-errors)) + (when failed-tests + (format t "~2&Failed tests: ~S~%" failed-tests)) + (when execute-error-tests + (format t "~2&Execute failures: ~S~%" execute-error-tests)) + (unix:unix-exit 1)) + (t + (unix:unix-exit 0))))) + +(defun run-all-tests () + (print-test-results (load-and-run-all-tests))) + +;;(run-all-tests) +;;(quit) -- GitLab