(with-mutex (mutex)
mutex)))
-(with-test (:name (:with-mutex :timeout))
- (let ((m (make-mutex)))
- (with-mutex (m)
- (assert (null (join-thread (make-thread
- (lambda ()
- (with-mutex (m :timeout 0.1)
- t)))))))
- (assert (join-thread (make-thread
- (lambda ()
- (with-mutex (m :timeout 0.1)
- t)))))))
-
(sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
void
(where sb-alien:unsigned-long))
;;;; Now the real tests...
+(with-test (:name (:with-mutex :timeout))
+ (let ((m (make-mutex)))
+ (with-mutex (m)
+ (assert (null (join-thread (make-thread
+ (lambda ()
+ (with-mutex (m :timeout 0.1)
+ t)))))))
+ (assert (join-thread (make-thread
+ (lambda ()
+ (with-mutex (m :timeout 0.1)
+ t)))))))
+
(with-test (:name (:interrupt-thread :deferrables-unblocked-by-lock))
(let ((lock (sb-thread::make-mutex))
(thread (make-join-thread (lambda ()
(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")
- :environment (test-util::test-env))
+ "-o" "threads-foreign.so" "threads-foreign.c"))
(sb-alien:load-shared-object (truename "threads-foreign.so"))
(sb-alien:define-alien-routine loop-forever sb-alien:void)
(delete-file "threads-foreign.c"))
(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)
(d1 (sb-thread:make-thread (lambda ()
(loop while run
do (defclass test-1 () ((a :initform :new-a)))
(write-char #\1)
- (force-output)))
+ #-win32 (force-output)))
:name "d1"))
(d2 (sb-thread:make-thread (lambda ()
(loop while run
do (defclass test-2 () ((b :initform :new-b)))
(write-char #\2)
- (force-output)))
+ #-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)))
(write-char #\3)
- (force-output)))
+ #-win32 (force-output)))
:name "d3"))
(i (sb-thread:make-thread (lambda ()
(loop while run
(assert (member (slot-value i 'b) '(:orig-b :new-b)))
(assert (member (slot-value i 'c) '(:orig-c :new-c))))
(write-char #\i)
- (force-output)))
+ #-win32 (force-output)))
:name "i")))
(format t "~%sleeping!~%")
(sleep 2.0)
(mapc (lambda (th)
(sb-thread:join-thread th)
(format t "~%joined ~S~%" (sb-thread:thread-name th)))
- (list d1 d2 d3 i))))
+ (list d1 d2 d3 i))
+ (force-output)))
(format t "parallel defclass test done~%")
(with-test (:name (:deadlock-detection :interrupts) :fails-on :win32)
(sb-thread:join-thread reader)))))
(writer))
(assert (eq result :ok))))
+
+(with-test (:name :thread-alloca)
+ (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)
+ (flet ((test ()
+ (let ((thread-fp-mode)
+ (fp-mode (dpb 0 sb-vm::float-sticky-bits (sb-vm:floating-point-modes))))
+ (sb-thread:join-thread
+ (sb-thread:make-thread
+ (lambda ()
+ (setf thread-fp-mode
+ (dpb 0 sb-vm::float-sticky-bits (sb-vm:floating-point-modes))))))
+ (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)))