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