+(terpri)
+
+(defun waste (&optional (n 100000))
+ (loop repeat n do (make-string 16384)))
+
+(loop for i below 100 do
+ (princ "!")
+ (force-output)
+ (sb-thread:make-thread
+ #'(lambda ()
+ (waste)))
+ (waste)
+ (sb-ext:gc))
+
+(terpri)
+
+(defparameter *aaa* nil)
+(loop for i below 100 do
+ (princ "!")
+ (force-output)
+ (sb-thread:make-thread
+ #'(lambda ()
+ (let ((*aaa* (waste)))
+ (waste))))
+ (let ((*aaa* (waste)))
+ (waste))
+ (sb-ext:gc))
+
+(format t "~&gc test done~%")
+
+;; this used to deadlock on session-lock
+(sb-thread:make-thread (lambda () (sb-ext:gc)))
+;; expose thread creation races by exiting quickly
+(sb-thread:make-thread (lambda ()))
+
+(defun exercise-syscall (fn reference-errno)
+ (sb-thread:make-thread
+ (lambda ()
+ (loop do
+ (funcall fn)
+ (let ((errno (sb-unix::get-errno)))
+ (sleep (random 0.1d0))
+ (unless (eql errno reference-errno)
+ (format t "Got errno: ~A (~A) instead of ~A~%"
+ errno
+ (sb-unix::strerror)
+ reference-errno)
+ (force-output)
+ (sb-ext:quit :unix-status 1)))))))
+
+(let* ((nanosleep-errno (progn
+ (sb-unix:nanosleep -1 0)
+ (sb-unix::get-errno)))
+ (open-errno (progn
+ (open "no-such-file"
+ :if-does-not-exist nil)
+ (sb-unix::get-errno)))
+ (threads
+ (list
+ (exercise-syscall (lambda () (sb-unix:nanosleep -1 0)) nanosleep-errno)
+ (exercise-syscall (lambda () (open "no-such-file"
+ :if-does-not-exist nil))
+ open-errno)
+ (sb-thread:make-thread (lambda () (loop (sb-ext:gc) (sleep 1)))))))
+ (sleep 10)
+ (princ "terminating threads")
+ (dolist (thread threads)
+ (sb-thread:terminate-thread thread)))
+
+(format t "~&errno test done~%")
+
+(loop repeat 100 do
+ (let ((thread (sb-thread:make-thread (lambda () (sleep 0.1)))))
+ (sb-thread:interrupt-thread
+ thread
+ (lambda ()
+ (assert (find-restart 'sb-thread:terminate-thread))))))
+
+(sb-ext:gc :full t)
+
+(format t "~&thread startup sigmask test done~%")
+
+(sb-debug::enable-debugger)
+(let* ((main-thread *current-thread*)
+ (interruptor-thread
+ (make-thread (lambda ()
+ (sleep 2)
+ (interrupt-thread main-thread #'break)
+ (sleep 2)
+ (interrupt-thread main-thread #'continue)))))
+ (with-session-lock (*session*)
+ (sleep 3))
+ (loop while (thread-alive-p interruptor-thread)))
+
+(format t "~&session lock test done~%")
+
+(sb-ext:gc :full t)
+(loop repeat 20 do
+ (wait-for-threads
+ (loop for i below 100 collect
+ (sb-thread:make-thread (lambda ()))))
+ (sb-ext:gc :full t)
+ (princ "+")
+ (force-output))
+
+(format t "~&creation test done~%")
+
+;; watch out for *current-thread* being the parent thread after exit
+(let ((thread (sb-thread:make-thread (lambda ()))))
+ (wait-for-threads (list thread))
+ (assert (null (symbol-value-in-thread 'sb-thread:*current-thread*
+ thread))))
+
+;; interrupt handlers are per-thread with pthreads, make sure the
+;; handler installed in one thread is global
+(sb-thread:make-thread
+ (lambda ()
+ (sb-ext:run-program "sleep" '("1") :search t :wait nil)))