1 ;;;; miscellaneous tests of thread stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absoluely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
16 (defpackage :thread-test
17 (:use :cl :sb-thread))
19 (in-package :thread-test)
21 (use-package :test-util)
23 ;;; Terminating a thread that's waiting for the terminal.
26 (let ((thread (make-thread (lambda ()
27 (sb-thread::get-foreground)))))
29 (assert (thread-alive-p thread))
30 (terminate-thread thread)
32 (assert (not (thread-alive-p thread))))
34 ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS
37 (with-test (:name without-interrupts+condition-wait
39 (let* ((lock (make-mutex))
40 (queue (make-waitqueue))
41 (thread (make-thread (lambda ()
42 (sb-sys:without-interrupts
44 (condition-wait queue lock)))))))
46 (assert (thread-alive-p thread))
47 (terminate-thread thread)
49 (assert (thread-alive-p thread))
50 (condition-notify queue)
52 (assert (not (thread-alive-p thread)))))
54 ;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
57 (with-test (:name without-interrupts+get-mutex)
58 (let* ((lock (make-mutex))
59 (bar (progn (get-mutex lock) nil))
60 (thread (make-thread (lambda ()
61 (sb-sys:without-interrupts
65 (assert (thread-alive-p thread))
66 (terminate-thread thread)
68 (assert (thread-alive-p thread))
71 (assert (not (thread-alive-p thread)))
72 (assert (eq :aborted (join-thread thread :default :aborted)))
76 (with-test (:name parallel-find-class)
78 (threads (loop repeat 10
79 collect (make-thread (lambda ()
82 do (find-class (gensym) nil))
85 (mapcar #'sb-thread:join-thread threads)