Add support to 'run-tests' for compiling in multiple threads

This changes only the test driver, without removing *world-lock*.
The environment variable SBCL_TEST_PARALLEL controls the number of
threads to create.
Produce a "test.log" file containing the elapsed time and namestring
of each '.pure' file run. (impure and/or cload files are not counted yet)

Some tests which use ASSERT-NO-CONSING are manually annotated to run
serially since presence of other threads would contaminate the test.
(The mechanism for asserting no-consing should be based on a compile-time
event recorder of whether we called the ALLOCATION macro, so that we don't
have to invoke the the generated code to decide if any allocation code was
produced. But this is a separate concern)

1 files changed, 28 insertions, 1 deletions

diff --git a/tests/test-funs.lisp b/tests/test-funs.lisp
index 04e0eed03..46a7ecaf8 100644
--- a/tests/test-funs.lisp
+++ b/tests/test-funs.lisp
@@ -6,8 +6,35 @@
                           :if-exists :supersede)
     (write-line "NIL" stream)))
 
+;;; Only the pure load-only (vs. compile+load) tests will be run concurrently.
+;;; The impure ones won't because we don't know what side-effects they depend on
+;;; (they are stateful with regard to order within the file).
+;;; Potentially the pure '.cload' tests could work.
 (defun load-test (file)
-  (load file :external-format :utf-8))
+  (let ((test-util::*deferred-test-forms*))
+    (declare (special test-util::*deferred-test-forms*))
+    (makunbound 'test-util::*deferred-test-forms*)
+    (load file :external-format :utf-8)
+    (when (boundp 'test-util::*deferred-test-forms*)
+      ;; Execute all tests that were wrapped in WITH-TEST
+      (let ((holder test-util::*deferred-test-forms*))
+        ;; Sort the slow tests in front of non-slow tests
+        (setf (elt holder 1) (nconc (nreverse (elt holder 1))
+                                    (nreverse (elt holder 2)))
+              (elt holder 2) nil)
+        (let ((n (elt holder 0))
+              (threads))
+          (format t "~&// Enabling ~D threads~%" n)
+          (dotimes (i n)
+            (push (sb-thread:make-thread
+                   (lambda ()
+                     (loop
+                      (let ((test (atomic-pop (svref holder 1))))
+                        (unless test (return))
+                        (test-util::run-test-concurrently test)))))
+                  threads))
+          (dolist (thr threads)
+            (sb-thread:join-thread thr)))))))
 
 (defun cload-test (file)
   (let ((compile-name (compile-file-pathname file)))