1.1--- a/lisp/std/tests/pkg.lisp Wed Oct 02 23:39:07 2024 -0400
1.2+++ b/lisp/std/tests/pkg.lisp Thu Oct 03 17:56:11 2024 -0400
1.3@@ -80,68 +80,6 @@
1.4 "Test standard error handlers"
1.5 (is (eql 'testing-err (deferror testing-err (std-error) nil (:auto t) (:documentation "testing")))))
1.6
1.7-(deftest threads ()
1.8- "Test standard thread functionality."
1.9- (is (eq *current-thread*
1.10- (find (thread-name *current-thread*) (list-all-threads)
1.11- :key #'thread-name :test #'equal)))
1.12- (is (find-thread-by-id (car (thread-id-list))))
1.13- (is (not (zerop (thread-count))))
1.14- (let ((threads
1.15- (make-threads 4 (lambda () (is (= 42 (1+ 41)))) :name "threads")))
1.16- (loop for th in threads
1.17- do (sb-thread:join-thread th))
1.18- (loop for th in threads
1.19- collect (is (not (sb-thread:thread-alive-p th)))))
1.20- (let ((m (make-mutex :name "mutex-test")))
1.21- (is
1.22- (and (not
1.23- (with-mutex (m)
1.24- (join-thread
1.25- (make-thread (lambda ()
1.26- (with-mutex (m :timeout 0.1)
1.27- t))))))
1.28- (join-thread
1.29- (make-thread (lambda ()
1.30- (with-mutex (m :timeout 0.1)
1.31- t)))))))
1.32- (let* ((sym (gensym))
1.33- (s (make-semaphore :name "semaphore-test"))
1.34- (th (make-thread (lambda () (wait-on-semaphore s)))))
1.35- (is (equal (multiple-value-list (join-thread th :timeout .001 :default sym))
1.36- (list sym :timeout)))
1.37- (signal-semaphore s)
1.38- (is (join-thread th)))
1.39- (signals join-thread-error (join-thread *current-thread*))
1.40- (is
1.41- (let ((m (make-mutex :name "rlock-test")))
1.42- (is (not (with-mutex (m) (join-thread (make-thread (lambda () (with-recursive-lock (m :wait-p nil) t)))))))
1.43- (join-thread (make-thread (lambda () (with-recursive-lock (m :wait-p nil) t))))))
1.44- (let ((queue (make-waitqueue :name "queue-test"))
1.45- (lock (make-mutex :name "lock-test"))
1.46- (n 0)
1.47- th)
1.48- (labels ((in-new-thread ()
1.49- (with-mutex (lock)
1.50- (assert (eql (mutex-owner lock) *current-thread*))
1.51- (condition-wait queue lock)
1.52- (assert (eql (mutex-owner lock) *current-thread*))
1.53- (is (= n 1))
1.54- (decf n))))
1.55- (setf th (make-thread #'in-new-thread))
1.56- (sleep 1)
1.57- (is (null (mutex-owner lock)))
1.58- (with-mutex (lock)
1.59- (incf n)
1.60- (condition-notify queue))
1.61- (is (= 0 (join-thread th))))))
1.62-
1.63-(deftest timers ()
1.64- "Test various timer functionality."
1.65- (sb-int:with-progressive-timeout (ttl :seconds 2)
1.66- (sleep 0.1)
1.67- (is (/= (ttl) 2.0))))
1.68-
1.69 (deftest fmt ()
1.70 "Test standard formatters"
1.71 (is (string= (format nil "| 1 | 2 | 3 |~%") (fmt-row '(1 2 3))))