mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
535caa829d
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)
60 lines
2.3 KiB
Common Lisp
60 lines
2.3 KiB
Common Lisp
(defvar *test-evaluator-mode* :compile)
|
|
|
|
(defun clear-test-status ()
|
|
(with-open-file (stream "test-status.lisp-expr"
|
|
:direction :output
|
|
: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)
|
|
(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)))
|
|
(unwind-protect
|
|
(progn
|
|
(compile-file file :print nil)
|
|
(load compile-name))
|
|
(ignore-errors
|
|
(delete-file compile-name)))))
|
|
|
|
(defun sh-test (file)
|
|
(clear-test-status)
|
|
(progn
|
|
(sb-posix:setenv "TEST_SBCL_EVALUATOR_MODE"
|
|
(string-downcase *test-evaluator-mode*)
|
|
1)
|
|
(let ((process (sb-ext:run-program "/bin/sh"
|
|
(list (native-namestring file))
|
|
:output *error-output*)))
|
|
(let ((*failures* nil))
|
|
(test-util:report-test-status))
|
|
(sb-ext:exit :code (process-exit-code process)))))
|