changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/std/tests/pkg.lisp

revision 692: f51b73f49946
parent 563: 8b10eabe89dd
     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))))