Split threads.impure in two

So that it can be run in parallel.

tests/input-manifest.lisp-expr

@@ -126,7 +126,7 @@
   "../contrib/sb-sprof/test.lisp" "../contrib/sb-sprof/graph.lisp")
  ("signals.impure.lisp" "contrib/sb-posix.fasl")
  ("stream.impure.lisp" "contrib/sb-posix.fasl")
- ("threads.impure.lisp"
+ ("threads-2.impure.lisp"
   "tests/alloca.so"
   "tests/threads-foreign.so")
  ("threads.test.sh" "tests/condition-wait-sigcont.lisp")

tests/threads-2.impure.lisp

@@ -0,0 +1,579 @@
+;;;; miscellaneous tests of thread stuff
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;
+;;;; This software is in the public domain and is provided with
+;;;; absoluely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(shadowing-import 'assertoid:assert-error)
+(use-package "SB-THREAD")
+(use-package "SB-SYS")
+
+(setf sb-unix::*on-dangerous-wait* :error)
+
+;;; semaphores
+
+(defmacro raises-timeout-p (&body body)
+  `(handler-case (progn (progn ,@body) nil)
+    (sb-ext:timeout () t)))
+
+(with-test (:name (semaphore :wait-forever)
+            :skipped-on (:and :sb-safepoint :linux)) ; hangs
+  (let ((sem (make-semaphore :count 0)))
+    (assert (raises-timeout-p
+              (sb-ext:with-timeout 0.1
+                (wait-on-semaphore sem))))))
+
+(with-test (:name (semaphore :initial-count))
+  (let ((sem (make-semaphore :count 1)))
+    (sb-ext:with-timeout 0.1
+      (assert (= 0 (wait-on-semaphore sem))))))
+
+(with-test (:name (semaphore :wait-then-signal))
+  (let ((sem (make-semaphore))
+        (signalled-p nil))
+    (make-join-thread (lambda ()
+                        (sleep 0.1)
+                        (setq signalled-p t)
+                        (signal-semaphore sem)))
+    (assert (= 0 (wait-on-semaphore sem)))
+    (assert signalled-p)))
+
+(with-test (:name (semaphore :signal-then-wait))
+  (let ((sem (make-semaphore))
+        (signalled-p nil))
+    (make-join-thread (lambda ()
+                        (signal-semaphore sem)
+                        (setq signalled-p t)))
+    (loop until signalled-p)
+    (assert (= 0 (wait-on-semaphore sem)))
+    (assert signalled-p)))
+
+(defun test-semaphore-multiple-signals (wait-on-semaphore)
+  (let* ((sem (make-semaphore :count 5))
+         (threads (loop repeat 20 collecting
+                        (make-join-thread (lambda ()
+                                            (funcall wait-on-semaphore sem))))))
+    (flet ((count-live-threads ()
+             (count-if #'thread-alive-p threads)))
+      (sleep 0.5)
+      (assert (= 15 (count-live-threads)))
+      (signal-semaphore sem 10)
+      (sleep 0.5)
+      (assert (= 5 (count-live-threads)))
+      (signal-semaphore sem 3)
+      (sleep 0.5)
+      (assert (= 2 (count-live-threads)))
+      (signal-semaphore sem 4)
+      (sleep 0.5)
+      (assert (= 0 (count-live-threads))))))
+
+(with-test (:name (semaphore :multiple-signals))
+  (test-semaphore-multiple-signals #'wait-on-semaphore))
+
+(with-test (:name (try-semaphore :trivial-fail))
+  (assert (eq (try-semaphore (make-semaphore :count 0)) 'nil)))
+
+(with-test (:name (try-semaphore :trivial-success))
+  (let ((sem (make-semaphore :count 1)))
+    (assert (= 0 (try-semaphore sem)))
+    (assert (zerop (semaphore-count sem)))))
+
+(with-test (:name (try-semaphore :trivial-fail :n>1))
+  (assert (eq (try-semaphore (make-semaphore :count 1) 2) 'nil)))
+
+(with-test (:name (try-semaphore :trivial-success :n>1))
+  (let ((sem (make-semaphore :count 10)))
+    (assert (= 5 (try-semaphore sem 5)))
+    (assert (= 0 (try-semaphore sem 5)))
+    (assert (zerop (semaphore-count sem)))))
+
+(with-test (:name (try-semaphore :emulate-wait-on-semaphore))
+  (flet ((busy-wait-on-semaphore (sem)
+           (loop until (try-semaphore sem) do (sleep 0.001))))
+    (test-semaphore-multiple-signals #'busy-wait-on-semaphore)))
+
+;;; Here we test that interrupting TRY-SEMAPHORE does not leave a
+;;; semaphore in a bad state.
+(with-test (:name (try-semaphore :interrupt-safe)
+            :broken-on :win32)
+  (flet ((make-threads (count fn)
+           (loop repeat count collect (make-thread fn)))
+         (kill-thread (thread)
+           (when (thread-alive-p thread)
+             (ignore-errors (terminate-thread thread))))
+         (count-live-threads (threads)
+           (count-if #'thread-alive-p threads)))
+    ;; WAITERS will already be waiting on the semaphore while
+    ;; threads-being-interrupted will perform TRY-SEMAPHORE on that
+    ;; semaphore, and MORE-WAITERS are new threads trying to wait on
+    ;; the semaphore during the interruption-fire.
+    (let* ((sem (make-semaphore :count 100))
+           (waiters (make-threads 20 #'(lambda ()
+                                         (wait-on-semaphore sem))))
+           (triers  (make-threads 40 #'(lambda ()
+                                         (sleep (random 0.01))
+                                         (try-semaphore sem (1+ (random 5))))))
+           (more-waiters
+            (loop repeat 10
+                  do (kill-thread (nth (random 40) triers))
+                  collect (make-thread #'(lambda () (wait-on-semaphore sem)))
+                  do (kill-thread (nth (random 40) triers)))))
+      (sleep 0.5)
+      ;; Now ensure that the waiting threads will all be waked up,
+      ;; i.e. that the semaphore is still working.
+      (loop repeat (+ (count-live-threads waiters)
+                      (count-live-threads more-waiters))
+            do (signal-semaphore sem))
+      (sleep 0.5)
+      (assert (zerop (count-live-threads triers)))
+      (assert (zerop (count-live-threads waiters)))
+      (assert (zerop (count-live-threads more-waiters))))))
+
+;; At some point %DECREMENT-SEMAPHORE did not adjust the remaining
+;; timeout after spurious wakeups, potentially leading to
+;; longer/infinite waiting despite the specified timeout.
+(with-test (:name (semaphore :timeout :spurious-wakeup))
+  (let* ((semaphore (make-semaphore))
+         (done nil)
+         (thread (make-thread (lambda ()
+                                (let ((mutex (sb-thread::semaphore-mutex semaphore))
+                                      (queue (sb-thread::semaphore-queue semaphore)))
+                                  (loop :until done :do
+                                     (with-mutex (mutex)
+                                       (condition-notify queue))))))))
+    (assert (eq nil (wait-on-semaphore semaphore :timeout .5)))
+    (setf done t)
+    (join-thread thread)))
+
+;; separate tests for (a) interrupting Lisp code, (b) C code, (c) a syscall,
+;; (d) waiting on a lock, (e) some code which we hope is likely to be
+;; in pseudo-atomic
+
+(with-test (:name (interrupt-thread :more-basics)
+            :broken-on :win32)
+  (let ((child (test-interrupt (lambda () (loop)))))
+    (terminate-thread child)))
+
+;;; For one of the interupt-thread tests, we want a foreign function
+;;; that does not make syscalls
+
+#-win32
+(progn
+  ;; When running from a read-only filesystem, and/or under a test scaffold in which
+  ;; no C compiler exists, we'll trust that the extra "test data file" was prepared
+  ;; already. Moreover we have to assume that it can't get out-of-date with respect
+  ;; to this lisp file. i.e. it always contains at least the one C function neccesary.
+  ;; (There's logically no "make clean ; make")
+  (unless (probe-file "threads-foreign.so")
+    (with-open-file (o "threads-foreign.c" :direction :output :if-exists :supersede)
+      (format o "void loop_forever() { while(1) ; }~%"))
+    (sb-ext:run-program "/bin/sh"
+                        '("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
+                          "-o" "threads-foreign.so" "threads-foreign.c"))
+    (delete-file "threads-foreign.c"))
+  (sb-alien:load-shared-object (truename "threads-foreign.so"))
+  (sb-alien:define-alien-routine loop-forever sb-alien:void))
+
+(with-test (:name (interrupt-thread :interrupt-foreign-loop)
+                  ;; This feature is explicitly unsupported on Win32.
+            :broken-on :win32)
+  (test-interrupt #'loop-forever :quit))
+
+(with-test (:name (interrupt-thread :interrupt-sleep)
+                  :broken-on :win32)
+  (let ((child (test-interrupt (lambda () (loop (sleep 2000))))))
+    (terminate-thread child)
+    (wait-for-threads (list child))))
+
+(defvar *runningp* nil)
+
+(with-test (:name (interrupt-thread :no-nesting) :broken-on :win32)
+  (let ((thread (make-thread (lambda ()
+                               (catch 'xxx
+                                 (loop))))))
+    (declare (special runningp))
+    (sleep 0.2)
+    (interrupt-thread thread (lambda ()
+                               (let ((*runningp* t))
+                                 (sleep 1))))
+    (sleep 0.2)
+    (interrupt-thread thread (lambda ()
+                               (throw 'xxx *runningp*)))
+    (assert (not (join-thread thread)))))
+
+(with-test (:name (interrupt-thread :nesting) :broken-on :win32)
+  (let ((thread (make-thread (lambda ()
+                               (catch 'xxx
+                                 (loop))))))
+    (declare (special runningp))
+    (sleep 0.2)
+    (interrupt-thread thread (lambda ()
+                               (let ((*runningp* t))
+                                 (sb-sys:with-interrupts
+                                   (sleep 1)))))
+    (sleep 0.2)
+    (interrupt-thread thread (lambda ()
+                               (throw 'xxx *runningp*)))
+    (assert (join-thread thread))))
+
+(with-test (:name :all-threads-have-abort-restart
+                  :broken-on :win32)
+  ;; This test can fail with without the extra semaphore.
+  ;; See also TEST-INTERRUPT in test-util for further explanation.
+  (let* ((sem (make-semaphore))
+         (thread (make-kill-thread
+                  (lambda ()
+                    (signal-semaphore sem)
+                    (sleep 100000000)))))
+    (wait-on-semaphore sem)
+    (interrupt-thread thread (lambda ()
+                               (assert (find-restart 'abort))))
+    (process-all-interrupts thread)))
+
+(sb-ext:gc :full t)
+
+;; expose thread creation races by exiting quickly
+(with-test (:name (:no-thread-creation-race :light))
+  (make-join-thread (lambda ())))
+
+(with-test (:name (:no-thread-creation-race :heavy))
+  (loop repeat 20 do
+        (wait-for-threads
+         (loop for i below 100 collect
+               (make-thread (lambda ()))))))
+
+;; interrupt handlers are per-thread with pthreads, make sure the
+;; handler installed in one thread is global
+(with-test (:name (:global-interrupt-handler))
+  (make-join-thread
+   (lambda ()
+     (sb-ext:run-program "sleep" '("1") :search t :wait nil))))
+
+;;;; Binding stack safety
+
+(defparameter *x* nil)
+(defparameter *n-gcs-requested* 0)
+(defparameter *n-gcs-done* 0)
+
+(let ((counter 0))
+  (defun make-something-big ()
+    (let ((x (make-string 32000)))
+      (incf counter)
+      (let ((counter counter))
+        (sb-ext:finalize x (lambda () (format t " ~S" counter)
+                                   (force-output)))))))
+
+(defmacro wait-for-gc ()
+  `(progn
+     (incf *n-gcs-requested*)
+     (loop while (< *n-gcs-done* *n-gcs-requested*))))
+
+(defun send-gc ()
+  (loop until (< *n-gcs-done* *n-gcs-requested*))
+  (format t "G")
+  (force-output)
+  (sb-ext:gc)
+  (incf *n-gcs-done*))
+
+#+(or x86 x86-64 riscv loongarch64) ;the only platforms with a *binding-stack-pointer* variable
+(defun exercise-binding ()
+  (loop
+   (let ((*x* (make-something-big)))
+     (let ((*x* 42))
+       ;; at this point the binding stack looks like this:
+       ;; NO-TLS-VALUE-MARKER, *x*, SOMETHING, *x*
+       t))
+   (wait-for-gc)
+   ;; sig_stop_for_gc_handler binds FREE_INTERRUPT_CONTEXT_INDEX. By
+   ;; now SOMETHING is gc'ed and the binding stack looks like this: 0,
+   ;; 0, SOMETHING, 0 (because the symbol slots are zeroed on
+   ;; unbinding but values are not).
+   (let ((*x* nil)
+         (binding-pointer-delta (ash 2 (- sb-vm:word-shift sb-vm:n-fixnum-tag-bits))))
+     ;; bump bsp as if a BIND had just started
+     (incf sb-vm::*binding-stack-pointer* binding-pointer-delta)
+     (wait-for-gc)
+     (decf sb-vm::*binding-stack-pointer* binding-pointer-delta))))
+
+#+(or x86 x86-64 riscv loongarch64) ;the only platforms with a *binding-stack-pointer* variable
+(with-test (:name (:binding-stack-gc-safety)
+            :broken-on :win32)
+  (let (threads)
+    (unwind-protect
+         (progn
+           (push (make-kill-thread #'exercise-binding) threads)
+           (push (make-kill-thread (lambda ()
+                                     (loop
+                                      (sleep 0.1)
+                                      (send-gc))))
+                 threads)
+           (sleep 3))
+      (mapc #'terminate-thread threads))))
+
+(with-test (:name :test-%thread-local-references)
+  (let ((mysym (gensym))
+        (fool1 (cons 1 2))
+        (fool2 (cons 2 3)))
+    (progv (list mysym) '(nil)
+      (let* ((i (sb-kernel:symbol-tls-index mysym))
+             (j (+ i sb-vm:n-word-bytes)))
+        (assert (eql (sap-ref-word (sb-thread::current-thread-sap) j)
+                     sb-vm:no-tls-value-marker))
+        (setf (sap-ref-lispobj (sb-thread::current-thread-sap) i) fool1
+              (sap-ref-lispobj (sb-thread::current-thread-sap) j) fool2)
+        ;; assert that my pointer arithmetic worked as expected
+        (assert (eq (symbol-value mysym) fool1))
+        ;; assert that FOOL1 is found by the TLS scan and that FOOL2 is not.
+        (let ((list (sb-thread::%thread-local-references)))
+          (assert (not (find sb-vm:no-tls-value-marker list
+                             :key #'sb-kernel:get-lisp-obj-address)))
+          (assert (member fool1 list))
+          (assert (not (member fool2 list))))
+        ;; repair the TLS entry that was corrupted by the test
+        (setf (sap-ref-word (sb-thread::current-thread-sap) j)
+              sb-vm:no-tls-value-marker)))))
+
+
+#|  ;; a cll post from eric marsden
+| (defun crash ()
+|   (setq *debugger-hook*
+|         (lambda (condition old-debugger-hook)
+|           (debug:backtrace 10)
+|           (unix:unix-exit 2)))
+|   #+live-dangerously
+|   (mp::start-sigalrm-yield)
+|   (flet ((roomy () (loop (with-output-to-string (*standard-output*) (room)))))
+|     (mp:make-process #'roomy)
+|     (mp:make-process #'roomy)))
+|#
+
+;;; Make sure that a deadline handler is not invoked twice in a row in
+;;; CONDITION-WAIT. See LP #512914 for a detailed explanation.
+;;;
+(with-test (:name (condition-wait :deadlines :LP-512914))
+  (let ((n 2)                      ; was empirically enough to trigger the bug
+        (mutex (make-mutex))
+        (waitq (make-waitqueue))
+        (threads nil)
+        (deadline-handler-run-twice? nil))
+    (dotimes (i n)
+      (let ((child
+              (make-thread
+               (lambda ()
+                 (handler-bind
+                     ((sb-sys:deadline-timeout
+                       (let ((already? nil))
+                         #'(lambda (c)
+                             (when already?
+                               (setq deadline-handler-run-twice? t))
+                             (setq already? t)
+                             (sleep 0.2)
+                             (sb-thread:condition-broadcast waitq)
+                             (sb-sys:defer-deadline 10.0 c)))))
+                   (sb-sys:with-deadline (:seconds 0.1)
+                     (with-mutex (mutex)
+                       (condition-wait waitq mutex))))))))
+        (push child threads)))
+    (mapc #'join-thread threads)
+    (assert (not deadline-handler-run-twice?))))
+
+;; You have to shoehorn this arbitrary sexpr into a feature expression
+;; to have the test summary show that a test was disabled.
+(unless (eql (extern-alien "verify_gens" int)
+             (+ sb-vm:+highest-normal-generation+ 2))
+  (pushnew :verify-gens *features*))
+
+(with-test (:name :backtrace :broken-on :verify-gens)
+  ;; Printing backtraces from several threads at once used to hang the
+  ;; whole SBCL process (discovered by accident due to a timer.impure
+  ;; test misbehaving). The cause was that packages weren't even
+  ;; thread-safe for only doing FIND-SYMBOL, and while printing
+  ;; backtraces a loot of symbol lookups need to be done due to
+  ;; *PRINT-ESCAPE*.
+  (let* ((threads (loop repeat 10
+                        collect (make-thread
+                                 (lambda ()
+                                   (dotimes (i 1000)
+                                     (with-output-to-string (*debug-io*)
+                                       (sb-debug:print-backtrace :count 10))))))))
+    (wait-for-threads threads)))
+
+
+
+(defun subtypep-hash-cache-test ()
+  (dotimes (i 10000)
+    (let ((type1 (random-type 500))
+          (type2 (random-type 500)))
+      (let ((a (subtypep type1 type2)))
+        (dotimes (i 100)
+          (assert (eq (subtypep type1 type2) a))))))
+  (write-char #\.)
+  (force-output))
+
+(with-test (:name (:hash-cache subtypep))
+  (mapc #'join-thread
+        ;; this didn't "reliably fail" with a small number of threads.
+        ;; 30 is a compromise between running time and confidence in the result.
+        (loop repeat 30
+              collect (make-thread #'subtypep-hash-cache-test)))
+  (terpri))
+
+;;;; FUNCTIONAL TESTS
+
+(with-test (:name (:parallel defclass))
+  (write-line "WARNING, WILL HANG ON FAILURE!")
+  (defclass test-1 () ((a :initform :orig-a)))
+  (defclass test-2 () ((b :initform :orig-b)))
+  (defclass test-3 (test-1 test-2) ((c :initform :orig-c)))
+  ;; This test is more likely to pass on Windows with the FORCE-OUTPUT
+  ;; calls disabled in the folloving code.  (As seen on a Server 2012
+  ;; installation.)  Clearly, this sort of workaround in a test is
+  ;; cheating, and might be hiding the underlying bug that the test is
+  ;; exposing.  Let's review this later.
+  (let* ((run t)
+         (output nil)
+         (d1 (sb-thread:make-thread (lambda ()
+                                      (loop while run
+                                            do (defclass test-1 () ((a :initform :new-a)))
+                                            (when output (write-char #\1))
+                                            #-win32 (force-output)))
+                                    :name "d1"))
+         (d2 (sb-thread:make-thread (lambda ()
+                                      (loop while run
+                                            do (defclass test-2 () ((b :initform :new-b)))
+                                               (when output (write-char #\2))
+                                               #-win32 (force-output)))
+                                    :name "d2"))
+         (d3 (sb-thread:make-thread (lambda ()
+                                      (loop while run
+                                            do (defclass test-3 (test-1 test-2) ((c :initform :new-c)))
+                                               (when output (write-char #\3))
+                                               #-win32 (force-output)))
+                                    :name "d3"))
+         (i (sb-thread:make-thread (lambda ()
+                                     (loop while run
+                                           do (let ((i (make-instance 'test-3)))
+                                                (assert (member (slot-value i 'a) '(:orig-a :new-a)))
+                                                (assert (member (slot-value i 'b) '(:orig-b :new-b)))
+                                                (assert (member (slot-value i 'c) '(:orig-c :new-c))))
+                                              (when output (write-char #\i))
+                                              #-win32 (force-output)))
+                                   :name "i")))
+    (format t "~%sleeping!~%")
+    (sleep 2.0)
+    (format t "~%stopping!~%")
+    (setf run nil)
+    (mapc (lambda (th)
+            (sb-thread:join-thread th)
+            (format t "~&joined ~S~%" (sb-thread:thread-name th)))
+          (list d1 d2 d3 i))
+    (force-output)))
+
+(with-test (:name :spinlock-api)
+  (handler-bind ((warning #'error))
+    (destructuring-bind (with make get release)
+        (assert-signal
+         (list (compile nil `(lambda (lock)
+                               (sb-thread::with-spinlock (lock)
+                                 t)))
+               (compile nil `(lambda ()
+                               (sb-thread::make-spinlock :name "foo")))
+               (compile nil `(lambda (lock)
+                               (sb-thread::get-spinlock lock)))
+               (compile nil `(lambda (lock)
+                               (sb-thread::release-spinlock lock))))
+         early-deprecation-warning 4)
+      (let ((lock (funcall make)))
+        (funcall get lock)
+        (funcall release lock)
+        (assert (eq t (funcall with lock)))))))
+
+(with-test (:name :interrupt-io-unnamed-pipe
+                  :broken-on :win32)
+  (let (result)
+    (labels
+        ((reader (fd)
+           (let ((stream (sb-sys:make-fd-stream fd
+                                                :element-type :default
+                                                :serve-events nil)))
+             (time
+              (let ((ok (handler-case
+                            (catch 'stop
+                              (progn
+                                (read-char stream)
+                                (sleep 0.1)
+                                (sleep 0.1)
+                                (sleep 0.1)))
+                          (error (c)
+                            c))))
+                (setf result ok)
+                (progn
+                  (format *trace-output* "~&=> ~A~%" ok)
+                  (force-output *trace-output*))))
+             (sleep 2)
+             (ignore-errors (close stream))))
+
+         (writer ()
+           (multiple-value-bind (read write)
+               (sb-unix:unix-pipe)
+             (let* ((reader (sb-thread:make-thread (lambda () (reader read))))
+                    (stream (sb-sys:make-fd-stream write
+                                                   :output t
+                                                   :element-type :default
+                                                   :serve-events nil))
+                    (ok :ok))
+               (sleep 1)
+               (sb-thread:interrupt-thread reader (lambda ()
+                                                    (print :throwing)
+                                                    (force-output)
+                                                    (throw 'stop ok)))
+               (sleep 1)
+               (setf ok :not-ok)
+               (write-char #\x stream)
+               (close stream)
+               (sb-thread:join-thread reader)))))
+      (writer))
+    (assert (eq result :ok))))
+
+(with-test (:name :thread-alloca)
+  (unless (probe-file "alloca.so")
+    (sb-ext:run-program "sh"
+                        '("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
+                          "alloca.c" "-o" "alloca.so")
+                        :search t))
+  (load-shared-object (truename "alloca.so"))
+  (alien-funcall (extern-alien "alloca_test" (function void)))
+  (sb-thread:join-thread
+   (sb-thread:make-thread
+    (lambda ()
+      (alien-funcall (extern-alien "alloca_test" (function void)))))))
+
+(with-test (:name :fp-mode-inheritance-threads)
+  (labels ((fp-mode ()
+             (let ((reserved-bits #+x86 (ash #b1110000011000000 16)
+                                  #-x86 0))
+               (logandc2 (dpb 0 sb-vm:float-sticky-bits (sb-vm:floating-point-modes))
+                         reserved-bits)))
+           (test ()
+             (let* ((fp-mode (fp-mode))
+                    (thread-fp-mode
+                      (sb-thread:join-thread
+                       (sb-thread:make-thread
+                        (lambda ()
+                          (fp-mode))))))
+               (assert (= fp-mode thread-fp-mode)))))
+    (test)
+    (sb-int:with-float-traps-masked (:divide-by-zero)
+      (test))
+    (setf (sb-vm:floating-point-modes)
+          (dpb sb-vm:float-divide-by-zero-trap-bit
+               sb-vm:float-traps-byte
+               (sb-vm:floating-point-modes)))
+    (test)))

tests/threads.impure.lisp

@@ -191,26 +191,6 @@
 (with-test (:name (join-thread :self-join))
   (assert-error (join-thread *current-thread*) join-thread-error))
 
-;;; For one of the interupt-thread tests, we want a foreign function
-;;; that does not make syscalls
-
-#-win32
-(progn
-  ;; When running from a read-only filesystem, and/or under a test scaffold in which
-  ;; no C compiler exists, we'll trust that the extra "test data file" was prepared
-  ;; already. Moreover we have to assume that it can't get out-of-date with respect
-  ;; to this lisp file. i.e. it always contains at least the one C function neccesary.
-  ;; (There's logically no "make clean ; make")
-  (unless (probe-file "threads-foreign.so")
-    (with-open-file (o "threads-foreign.c" :direction :output :if-exists :supersede)
-      (format o "void loop_forever() { while(1) ; }~%"))
-    (sb-ext:run-program "/bin/sh"
-                        '("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
-                          "-o" "threads-foreign.so" "threads-foreign.c"))
-    (delete-file "threads-foreign.c"))
-  (sb-alien:load-shared-object (truename "threads-foreign.so"))
-  (sb-alien:define-alien-routine loop-forever sb-alien:void))
-
 ;;; elementary "can we get a lock and release it again"
 (with-test (:name (:mutex :basics))
   (let ((l (make-mutex :name "foo"))
@@ -391,543 +371,3 @@
                                           :deadline))))))
                   'nil)))))
 
-;;; semaphores
-
-(defmacro raises-timeout-p (&body body)
-  `(handler-case (progn (progn ,@body) nil)
-    (sb-ext:timeout () t)))
-
-(with-test (:name (semaphore :wait-forever)
-            :skipped-on (:and :sb-safepoint :linux)) ; hangs
-  (let ((sem (make-semaphore :count 0)))
-    (assert (raises-timeout-p
-              (sb-ext:with-timeout 0.1
-                (wait-on-semaphore sem))))))
-
-(with-test (:name (semaphore :initial-count))
-  (let ((sem (make-semaphore :count 1)))
-    (sb-ext:with-timeout 0.1
-      (assert (= 0 (wait-on-semaphore sem))))))
-
-(with-test (:name (semaphore :wait-then-signal))
-  (let ((sem (make-semaphore))
-        (signalled-p nil))
-    (make-join-thread (lambda ()
-                        (sleep 0.1)
-                        (setq signalled-p t)
-                        (signal-semaphore sem)))
-    (assert (= 0 (wait-on-semaphore sem)))
-    (assert signalled-p)))
-
-(with-test (:name (semaphore :signal-then-wait))
-  (let ((sem (make-semaphore))
-        (signalled-p nil))
-    (make-join-thread (lambda ()
-                        (signal-semaphore sem)
-                        (setq signalled-p t)))
-    (loop until signalled-p)
-    (assert (= 0 (wait-on-semaphore sem)))
-    (assert signalled-p)))
-
-(defun test-semaphore-multiple-signals (wait-on-semaphore)
-  (let* ((sem (make-semaphore :count 5))
-         (threads (loop repeat 20 collecting
-                        (make-join-thread (lambda ()
-                                            (funcall wait-on-semaphore sem))))))
-    (flet ((count-live-threads ()
-             (count-if #'thread-alive-p threads)))
-      (sleep 0.5)
-      (assert (= 15 (count-live-threads)))
-      (signal-semaphore sem 10)
-      (sleep 0.5)
-      (assert (= 5 (count-live-threads)))
-      (signal-semaphore sem 3)
-      (sleep 0.5)
-      (assert (= 2 (count-live-threads)))
-      (signal-semaphore sem 4)
-      (sleep 0.5)
-      (assert (= 0 (count-live-threads))))))
-
-(with-test (:name (semaphore :multiple-signals))
-  (test-semaphore-multiple-signals #'wait-on-semaphore))
-
-(with-test (:name (try-semaphore :trivial-fail))
-  (assert (eq (try-semaphore (make-semaphore :count 0)) 'nil)))
-
-(with-test (:name (try-semaphore :trivial-success))
-  (let ((sem (make-semaphore :count 1)))
-    (assert (= 0 (try-semaphore sem)))
-    (assert (zerop (semaphore-count sem)))))
-
-(with-test (:name (try-semaphore :trivial-fail :n>1))
-  (assert (eq (try-semaphore (make-semaphore :count 1) 2) 'nil)))
-
-(with-test (:name (try-semaphore :trivial-success :n>1))
-  (let ((sem (make-semaphore :count 10)))
-    (assert (= 5 (try-semaphore sem 5)))
-    (assert (= 0 (try-semaphore sem 5)))
-    (assert (zerop (semaphore-count sem)))))
-
-(with-test (:name (try-semaphore :emulate-wait-on-semaphore))
-  (flet ((busy-wait-on-semaphore (sem)
-           (loop until (try-semaphore sem) do (sleep 0.001))))
-    (test-semaphore-multiple-signals #'busy-wait-on-semaphore)))
-
-;;; Here we test that interrupting TRY-SEMAPHORE does not leave a
-;;; semaphore in a bad state.
-(with-test (:name (try-semaphore :interrupt-safe)
-            :broken-on :win32)
-  (flet ((make-threads (count fn)
-           (loop repeat count collect (make-thread fn)))
-         (kill-thread (thread)
-           (when (thread-alive-p thread)
-             (ignore-errors (terminate-thread thread))))
-         (count-live-threads (threads)
-           (count-if #'thread-alive-p threads)))
-    ;; WAITERS will already be waiting on the semaphore while
-    ;; threads-being-interrupted will perform TRY-SEMAPHORE on that
-    ;; semaphore, and MORE-WAITERS are new threads trying to wait on
-    ;; the semaphore during the interruption-fire.
-    (let* ((sem (make-semaphore :count 100))
-           (waiters (make-threads 20 #'(lambda ()
-                                         (wait-on-semaphore sem))))
-           (triers  (make-threads 40 #'(lambda ()
-                                         (sleep (random 0.01))
-                                         (try-semaphore sem (1+ (random 5))))))
-           (more-waiters
-            (loop repeat 10
-                  do (kill-thread (nth (random 40) triers))
-                  collect (make-thread #'(lambda () (wait-on-semaphore sem)))
-                  do (kill-thread (nth (random 40) triers)))))
-      (sleep 0.5)
-      ;; Now ensure that the waiting threads will all be waked up,
-      ;; i.e. that the semaphore is still working.
-      (loop repeat (+ (count-live-threads waiters)
-                      (count-live-threads more-waiters))
-            do (signal-semaphore sem))
-      (sleep 0.5)
-      (assert (zerop (count-live-threads triers)))
-      (assert (zerop (count-live-threads waiters)))
-      (assert (zerop (count-live-threads more-waiters))))))
-
-;; At some point %DECREMENT-SEMAPHORE did not adjust the remaining
-;; timeout after spurious wakeups, potentially leading to
-;; longer/infinite waiting despite the specified timeout.
-(with-test (:name (semaphore :timeout :spurious-wakeup))
-  (let* ((semaphore (make-semaphore))
-         (done nil)
-         (thread (make-thread (lambda ()
-                                (let ((mutex (sb-thread::semaphore-mutex semaphore))
-                                      (queue (sb-thread::semaphore-queue semaphore)))
-                                  (loop :until done :do
-                                     (with-mutex (mutex)
-                                       (condition-notify queue))))))))
-    (assert (eq nil (wait-on-semaphore semaphore :timeout .5)))
-    (setf done t)
-    (join-thread thread)))
-
-;; separate tests for (a) interrupting Lisp code, (b) C code, (c) a syscall,
-;; (d) waiting on a lock, (e) some code which we hope is likely to be
-;; in pseudo-atomic
-
-(with-test (:name (interrupt-thread :more-basics)
-            :broken-on :win32)
-  (let ((child (test-interrupt (lambda () (loop)))))
-    (terminate-thread child)))
-
-(with-test (:name (interrupt-thread :interrupt-foreign-loop)
-                  ;; This feature is explicitly unsupported on Win32.
-            :broken-on :win32)
-  (test-interrupt #'loop-forever :quit))
-
-(with-test (:name (interrupt-thread :interrupt-sleep)
-                  :broken-on :win32)
-  (let ((child (test-interrupt (lambda () (loop (sleep 2000))))))
-    (terminate-thread child)
-    (wait-for-threads (list child))))
-
-(defvar *runningp* nil)
-
-(with-test (:name (interrupt-thread :no-nesting) :broken-on :win32)
-  (let ((thread (make-thread (lambda ()
-                               (catch 'xxx
-                                 (loop))))))
-    (declare (special runningp))
-    (sleep 0.2)
-    (interrupt-thread thread (lambda ()
-                               (let ((*runningp* t))
-                                 (sleep 1))))
-    (sleep 0.2)
-    (interrupt-thread thread (lambda ()
-                               (throw 'xxx *runningp*)))
-    (assert (not (join-thread thread)))))
-
-(with-test (:name (interrupt-thread :nesting) :broken-on :win32)
-  (let ((thread (make-thread (lambda ()
-                               (catch 'xxx
-                                 (loop))))))
-    (declare (special runningp))
-    (sleep 0.2)
-    (interrupt-thread thread (lambda ()
-                               (let ((*runningp* t))
-                                 (sb-sys:with-interrupts
-                                   (sleep 1)))))
-    (sleep 0.2)
-    (interrupt-thread thread (lambda ()
-                               (throw 'xxx *runningp*)))
-    (assert (join-thread thread))))
-
-(with-test (:name :all-threads-have-abort-restart
-                  :broken-on :win32)
-  ;; This test can fail with without the extra semaphore.
-  ;; See also TEST-INTERRUPT in test-util for further explanation.
-  (let* ((sem (make-semaphore))
-         (thread (make-kill-thread
-                  (lambda ()
-                    (signal-semaphore sem)
-                    (sleep 100000000)))))
-    (wait-on-semaphore sem)
-    (interrupt-thread thread (lambda ()
-                               (assert (find-restart 'abort))))
-    (process-all-interrupts thread)))
-
-(sb-ext:gc :full t)
-
-;; expose thread creation races by exiting quickly
-(with-test (:name (:no-thread-creation-race :light))
-  (make-join-thread (lambda ())))
-
-(with-test (:name (:no-thread-creation-race :heavy))
-  (loop repeat 20 do
-        (wait-for-threads
-         (loop for i below 100 collect
-               (make-thread (lambda ()))))))
-
-;; interrupt handlers are per-thread with pthreads, make sure the
-;; handler installed in one thread is global
-(with-test (:name (:global-interrupt-handler))
-  (make-join-thread
-   (lambda ()
-     (sb-ext:run-program "sleep" '("1") :search t :wait nil))))
-
-;;;; Binding stack safety
-
-(defparameter *x* nil)
-(defparameter *n-gcs-requested* 0)
-(defparameter *n-gcs-done* 0)
-
-(let ((counter 0))
-  (defun make-something-big ()
-    (let ((x (make-string 32000)))
-      (incf counter)
-      (let ((counter counter))
-        (sb-ext:finalize x (lambda () (format t " ~S" counter)
-                                   (force-output)))))))
-
-(defmacro wait-for-gc ()
-  `(progn
-     (incf *n-gcs-requested*)
-     (loop while (< *n-gcs-done* *n-gcs-requested*))))
-
-(defun send-gc ()
-  (loop until (< *n-gcs-done* *n-gcs-requested*))
-  (format t "G")
-  (force-output)
-  (sb-ext:gc)
-  (incf *n-gcs-done*))
-
-#+(or x86 x86-64 riscv loongarch64) ;the only platforms with a *binding-stack-pointer* variable
-(defun exercise-binding ()
-  (loop
-   (let ((*x* (make-something-big)))
-     (let ((*x* 42))
-       ;; at this point the binding stack looks like this:
-       ;; NO-TLS-VALUE-MARKER, *x*, SOMETHING, *x*
-       t))
-   (wait-for-gc)
-   ;; sig_stop_for_gc_handler binds FREE_INTERRUPT_CONTEXT_INDEX. By
-   ;; now SOMETHING is gc'ed and the binding stack looks like this: 0,
-   ;; 0, SOMETHING, 0 (because the symbol slots are zeroed on
-   ;; unbinding but values are not).
-   (let ((*x* nil)
-         (binding-pointer-delta (ash 2 (- sb-vm:word-shift sb-vm:n-fixnum-tag-bits))))
-     ;; bump bsp as if a BIND had just started
-     (incf sb-vm::*binding-stack-pointer* binding-pointer-delta)
-     (wait-for-gc)
-     (decf sb-vm::*binding-stack-pointer* binding-pointer-delta))))
-
-#+(or x86 x86-64 riscv loongarch64) ;the only platforms with a *binding-stack-pointer* variable
-(with-test (:name (:binding-stack-gc-safety)
-            :broken-on :win32)
-  (let (threads)
-    (unwind-protect
-         (progn
-           (push (make-kill-thread #'exercise-binding) threads)
-           (push (make-kill-thread (lambda ()
-                                     (loop
-                                      (sleep 0.1)
-                                      (send-gc))))
-                 threads)
-           (sleep 3))
-      (mapc #'terminate-thread threads))))
-
-(with-test (:name :test-%thread-local-references)
-  (let ((mysym (gensym))
-        (fool1 (cons 1 2))
-        (fool2 (cons 2 3)))
-    (progv (list mysym) '(nil)
-      (let* ((i (sb-kernel:symbol-tls-index mysym))
-             (j (+ i sb-vm:n-word-bytes)))
-        (assert (eql (sap-ref-word (sb-thread::current-thread-sap) j)
-                     sb-vm:no-tls-value-marker))
-        (setf (sap-ref-lispobj (sb-thread::current-thread-sap) i) fool1
-              (sap-ref-lispobj (sb-thread::current-thread-sap) j) fool2)
-        ;; assert that my pointer arithmetic worked as expected
-        (assert (eq (symbol-value mysym) fool1))
-        ;; assert that FOOL1 is found by the TLS scan and that FOOL2 is not.
-        (let ((list (sb-thread::%thread-local-references)))
-          (assert (not (find sb-vm:no-tls-value-marker list
-                             :key #'sb-kernel:get-lisp-obj-address)))
-          (assert (member fool1 list))
-          (assert (not (member fool2 list))))
-        ;; repair the TLS entry that was corrupted by the test
-        (setf (sap-ref-word (sb-thread::current-thread-sap) j)
-              sb-vm:no-tls-value-marker)))))
-
-
-#|  ;; a cll post from eric marsden
-| (defun crash ()
-|   (setq *debugger-hook*
-|         (lambda (condition old-debugger-hook)
-|           (debug:backtrace 10)
-|           (unix:unix-exit 2)))
-|   #+live-dangerously
-|   (mp::start-sigalrm-yield)
-|   (flet ((roomy () (loop (with-output-to-string (*standard-output*) (room)))))
-|     (mp:make-process #'roomy)
-|     (mp:make-process #'roomy)))
-|#
-
-;;; Make sure that a deadline handler is not invoked twice in a row in
-;;; CONDITION-WAIT. See LP #512914 for a detailed explanation.
-;;;
-(with-test (:name (condition-wait :deadlines :LP-512914))
-  (let ((n 2)                      ; was empirically enough to trigger the bug
-        (mutex (make-mutex))
-        (waitq (make-waitqueue))
-        (threads nil)
-        (deadline-handler-run-twice? nil))
-    (dotimes (i n)
-      (let ((child
-              (make-thread
-               (lambda ()
-                 (handler-bind
-                     ((sb-sys:deadline-timeout
-                       (let ((already? nil))
-                         #'(lambda (c)
-                             (when already?
-                               (setq deadline-handler-run-twice? t))
-                             (setq already? t)
-                             (sleep 0.2)
-                             (sb-thread:condition-broadcast waitq)
-                             (sb-sys:defer-deadline 10.0 c)))))
-                   (sb-sys:with-deadline (:seconds 0.1)
-                     (with-mutex (mutex)
-                       (condition-wait waitq mutex))))))))
-        (push child threads)))
-    (mapc #'join-thread threads)
-    (assert (not deadline-handler-run-twice?))))
-
-;; You have to shoehorn this arbitrary sexpr into a feature expression
-;; to have the test summary show that a test was disabled.
-(unless (eql (extern-alien "verify_gens" int)
-             (+ sb-vm:+highest-normal-generation+ 2))
-  (pushnew :verify-gens *features*))
-
-(with-test (:name :backtrace :broken-on :verify-gens)
-  ;; Printing backtraces from several threads at once used to hang the
-  ;; whole SBCL process (discovered by accident due to a timer.impure
-  ;; test misbehaving). The cause was that packages weren't even
-  ;; thread-safe for only doing FIND-SYMBOL, and while printing
-  ;; backtraces a loot of symbol lookups need to be done due to
-  ;; *PRINT-ESCAPE*.
-  (let* ((threads (loop repeat 10
-                        collect (make-thread
-                                 (lambda ()
-                                   (dotimes (i 1000)
-                                     (with-output-to-string (*debug-io*)
-                                       (sb-debug:print-backtrace :count 10))))))))
-    (wait-for-threads threads)))
-
-
-
-(defun subtypep-hash-cache-test ()
-  (dotimes (i 10000)
-    (let ((type1 (random-type 500))
-          (type2 (random-type 500)))
-      (let ((a (subtypep type1 type2)))
-        (dotimes (i 100)
-          (assert (eq (subtypep type1 type2) a))))))
-  (write-char #\.)
-  (force-output))
-
-(with-test (:name (:hash-cache subtypep))
-  (mapc #'join-thread
-        ;; this didn't "reliably fail" with a small number of threads.
-        ;; 30 is a compromise between running time and confidence in the result.
-        (loop repeat 30
-              collect (make-thread #'subtypep-hash-cache-test)))
-  (terpri))
-
-;;;; FUNCTIONAL TESTS
-
-(with-test (:name (:parallel defclass))
-  (write-line "WARNING, WILL HANG ON FAILURE!")
-  (defclass test-1 () ((a :initform :orig-a)))
-  (defclass test-2 () ((b :initform :orig-b)))
-  (defclass test-3 (test-1 test-2) ((c :initform :orig-c)))
-  ;; This test is more likely to pass on Windows with the FORCE-OUTPUT
-  ;; calls disabled in the folloving code.  (As seen on a Server 2012
-  ;; installation.)  Clearly, this sort of workaround in a test is
-  ;; cheating, and might be hiding the underlying bug that the test is
-  ;; exposing.  Let's review this later.
-  (let* ((run t)
-         (output nil)
-         (d1 (sb-thread:make-thread (lambda ()
-                                      (loop while run
-                                            do (defclass test-1 () ((a :initform :new-a)))
-                                            (when output (write-char #\1))
-                                            #-win32 (force-output)))
-                                    :name "d1"))
-         (d2 (sb-thread:make-thread (lambda ()
-                                      (loop while run
-                                            do (defclass test-2 () ((b :initform :new-b)))
-                                               (when output (write-char #\2))
-                                               #-win32 (force-output)))
-                                    :name "d2"))
-         (d3 (sb-thread:make-thread (lambda ()
-                                      (loop while run
-                                            do (defclass test-3 (test-1 test-2) ((c :initform :new-c)))
-                                               (when output (write-char #\3))
-                                               #-win32 (force-output)))
-                                    :name "d3"))
-         (i (sb-thread:make-thread (lambda ()
-                                     (loop while run
-                                           do (let ((i (make-instance 'test-3)))
-                                                (assert (member (slot-value i 'a) '(:orig-a :new-a)))
-                                                (assert (member (slot-value i 'b) '(:orig-b :new-b)))
-                                                (assert (member (slot-value i 'c) '(:orig-c :new-c))))
-                                              (when output (write-char #\i))
-                                              #-win32 (force-output)))
-                                   :name "i")))
-    (format t "~%sleeping!~%")
-    (sleep 2.0)
-    (format t "~%stopping!~%")
-    (setf run nil)
-    (mapc (lambda (th)
-            (sb-thread:join-thread th)
-            (format t "~&joined ~S~%" (sb-thread:thread-name th)))
-          (list d1 d2 d3 i))
-    (force-output)))
-
-(with-test (:name :spinlock-api)
-  (handler-bind ((warning #'error))
-    (destructuring-bind (with make get release)
-        (assert-signal
-         (list (compile nil `(lambda (lock)
-                               (sb-thread::with-spinlock (lock)
-                                 t)))
-               (compile nil `(lambda ()
-                               (sb-thread::make-spinlock :name "foo")))
-               (compile nil `(lambda (lock)
-                               (sb-thread::get-spinlock lock)))
-               (compile nil `(lambda (lock)
-                               (sb-thread::release-spinlock lock))))
-         early-deprecation-warning 4)
-      (let ((lock (funcall make)))
-        (funcall get lock)
-        (funcall release lock)
-        (assert (eq t (funcall with lock)))))))
-
-(with-test (:name :interrupt-io-unnamed-pipe
-                  :broken-on :win32)
-  (let (result)
-    (labels
-        ((reader (fd)
-           (let ((stream (sb-sys:make-fd-stream fd
-                                                :element-type :default
-                                                :serve-events nil)))
-             (time
-              (let ((ok (handler-case
-                            (catch 'stop
-                              (progn
-                                (read-char stream)
-                                (sleep 0.1)
-                                (sleep 0.1)
-                                (sleep 0.1)))
-                          (error (c)
-                            c))))
-                (setf result ok)
-                (progn
-                  (format *trace-output* "~&=> ~A~%" ok)
-                  (force-output *trace-output*))))
-             (sleep 2)
-             (ignore-errors (close stream))))
-
-         (writer ()
-           (multiple-value-bind (read write)
-               (sb-unix:unix-pipe)
-             (let* ((reader (sb-thread:make-thread (lambda () (reader read))))
-                    (stream (sb-sys:make-fd-stream write
-                                                   :output t
-                                                   :element-type :default
-                                                   :serve-events nil))
-                    (ok :ok))
-               (sleep 1)
-               (sb-thread:interrupt-thread reader (lambda ()
-                                                    (print :throwing)
-                                                    (force-output)
-                                                    (throw 'stop ok)))
-               (sleep 1)
-               (setf ok :not-ok)
-               (write-char #\x stream)
-               (close stream)
-               (sb-thread:join-thread reader)))))
-      (writer))
-    (assert (eq result :ok))))
-
-(with-test (:name :thread-alloca)
-  (unless (probe-file "alloca.so")
-    (sb-ext:run-program "sh"
-                        '("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
-                          "alloca.c" "-o" "alloca.so")
-                        :search t))
-  (load-shared-object (truename "alloca.so"))
-  (alien-funcall (extern-alien "alloca_test" (function void)))
-  (sb-thread:join-thread
-   (sb-thread:make-thread
-    (lambda ()
-      (alien-funcall (extern-alien "alloca_test" (function void)))))))
-
-(with-test (:name :fp-mode-inheritance-threads)
-  (labels ((fp-mode ()
-             (let ((reserved-bits #+x86 (ash #b1110000011000000 16)
-                                  #-x86 0))
-               (logandc2 (dpb 0 sb-vm:float-sticky-bits (sb-vm:floating-point-modes))
-                         reserved-bits)))
-           (test ()
-             (let* ((fp-mode (fp-mode))
-                    (thread-fp-mode
-                      (sb-thread:join-thread
-                       (sb-thread:make-thread
-                        (lambda ()
-                          (fp-mode))))))
-               (assert (= fp-mode thread-fp-mode)))))
-    (test)
-    (sb-int:with-float-traps-masked (:divide-by-zero)
-      (test))
-    (setf (sb-vm:floating-point-modes)
-          (dpb sb-vm:float-divide-by-zero-trap-bit
-               sb-vm:float-traps-byte
-               (sb-vm:floating-point-modes)))
-    (test)))

tests/timing

@@ -4,7 +4,7 @@
 ("alloc-histo.impure" 509)
 ("aprof.impure" 553)
 ("arenaheapwaste.impure" 1400)
-("arith-2.pure" 408)
+("arith-2.pure" 6408)
 ("alien.impure" 1174)
 ("assembler.pure" 237)
 ("autoclose-stream.impure" 163)
@@ -96,7 +96,7 @@
 ("defstruct.impure" 1605)
 ("fast-eval.impure" 86)
 ("arith-combinations.pure" 13955)
-("dynamic-extent.pure" 1575)
+("dynamic-extent.pure" 2575)
 ("filecompile.impure-cload" 86)
 ("filecompile.impure" 145)
 ("external-format.pure" 871)
@@ -181,7 +181,8 @@
 ("mop-20.impure-cload" 147)
 ("mop-21.impure-cload" 130)
 ("mop-22.impure-cload" 137)
-("threads.impure" 24573)
+("threads.impure" 14573)
+("threads-2.impure" 14573)
 ("mop-23.impure" 144)
 ("mop-25.impure" 110)
 ("mop-26.impure" 115)
@@ -203,7 +204,7 @@
 ("lzcore.test" 2495)
 ("mop.impure-cload" 135)
 ("load.impure" 3994)
-("gethash-concurrency.pure" 25213)
+("gethash-concurrency.pure" 15213)
 ("mop.pure" 213)
 ("octets.pure" 184)
 ("mop.impure" 351)
@@ -274,7 +275,7 @@
 ("smoke.impure" 986)
 ("stream.impure-cload" 124)
 ("seq.pure" 1859)
-("stream.test" 98)
+("stream.test" 1198)
 ("stream.pure" 210)
 ("style-warnings.impure" 99)
 ("string.pure" 191)