X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=9672f49ee951644d02672fa50209bbf8074aed3b;hb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;hp=e3db63e6e477434e63b7c142fe35addd907a3a61;hpb=5abf3b4b94c8c2315777e63729293395dc54992c;p=sbcl.git diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index e3db63e..9672f49 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -342,8 +342,6 @@ (grab-mutex m :waitp nil))))))))) (with-test (:name (:grab-mutex :timeout :acquisition-fail)) - #+sb-lutex - (error "Mutex timeout not supported here.") (let ((m (make-mutex)) (w (make-semaphore))) (with-mutex (m) @@ -358,8 +356,6 @@ (assert (null (join-thread th))))))) (with-test (:name (:grab-mutex :timeout :acquisition-success)) - #+sb-lutex - (error "Mutex timeout not supported here.") (let ((m (make-mutex)) (child)) (with-mutex (m) @@ -368,8 +364,6 @@ (assert (eq (join-thread child) 't)))) (with-test (:name (:grab-mutex :timeout+deadline)) - #+sb-lutex - (error "Mutex timeout not supported here.") (let ((m (make-mutex)) (w (make-semaphore))) (with-mutex (m) @@ -384,8 +378,6 @@ (assert (eq (join-thread th) :deadline)))))) (with-test (:name (:grab-mutex :waitp+deadline)) - #+sb-lutex - (error "Mutex timeout not supported here.") (let ((m (make-mutex))) (with-mutex (m) (assert (eq (join-thread @@ -567,7 +559,8 @@ (defun alloc-stuff () (copy-list '(1 2 3 4 5))) -(with-test (:name (:interrupt-thread :interrupt-consing-child)) +(with-test (:name (:interrupt-thread :interrupt-consing-child) + :broken-on :darwin) (let ((thread (sb-thread:make-thread (lambda () (loop (alloc-stuff)))))) (let ((killers (loop repeat 4 collect @@ -852,11 +845,12 @@ ;; now SOMETHING is gc'ed and the binding stack looks like this: 0, ;; 0, SOMETHING, 0 (because the symbol slots are zeroed on ;; unbinding but values are not). - (let ((*x* nil)) + (let ((*x* nil) + (binding-pointer-delta (ash 2 (- sb-vm:word-shift sb-vm:n-fixnum-tag-bits)))) ;; bump bsp as if a BIND had just started - (incf sb-vm::*binding-stack-pointer* 2) + (incf sb-vm::*binding-stack-pointer* binding-pointer-delta) (wait-for-gc) - (decf sb-vm::*binding-stack-pointer* 2)))) + (decf sb-vm::*binding-stack-pointer* binding-pointer-delta)))) (with-test (:name (:binding-stack-gc-safety)) (let (threads) @@ -883,7 +877,13 @@ (sb-debug:backtrace) (catch 'done)) -(with-test (:name (:unsynchronized-hash-table)) +(with-test (:name (:unsynchronized-hash-table) + ;; FIXME: This test occasionally eats out craploads + ;; of heap instead of expected error early. Not 100% + ;; sure if it would finish as expected, but since it + ;; hits swap on my system I'm not likely to find out + ;; soon. Disabling for now. -- nikodemus + :skipped-on :sbcl) ;; We expect a (probable) error here: parellel readers and writers ;; on a hash-table are not expected to work -- but we also don't ;; expect this to corrupt the image. @@ -1073,37 +1073,35 @@ ;;; Make sure that a deadline handler is not invoked twice in a row in ;;; CONDITION-WAIT. See LP #512914 for a detailed explanation. ;;; -#-sb-lutex ; See KLUDGE above: no deadlines for condition-wait+lutexes. -(with-test (:name (:condition-wait :deadlines :LP-512914)) - (let ((n 2) ; was empirically enough to trigger the bug +(with-test (:name (:condition-wait :deadlines :LP-512914) + :skipped-on '(not :sb-futex)) + (let ((n 2) ; was empirically enough to trigger the bug (mutex (sb-thread:make-mutex)) (waitq (sb-thread:make-waitqueue)) (threads nil) (deadline-handler-run-twice? nil)) (dotimes (i n) (let ((child - (sb-thread:make-thread - #'(lambda () - (handler-bind - ((sb-sys:deadline-timeout - (let ((already? nil)) - #'(lambda (c) - (when already? - (setq deadline-handler-run-twice? t)) - (setq already? t) - (sleep 0.2) - (sb-thread:condition-broadcast waitq) - (sb-sys:defer-deadline 10.0 c))))) - (sb-sys:with-deadline (:seconds 0.1) - (sb-thread:with-mutex (mutex) - (sb-thread:condition-wait waitq mutex)))))))) + (sb-thread:make-thread + #'(lambda () + (handler-bind + ((sb-sys:deadline-timeout + (let ((already? nil)) + #'(lambda (c) + (when already? + (setq deadline-handler-run-twice? t)) + (setq already? t) + (sleep 0.2) + (sb-thread:condition-broadcast waitq) + (sb-sys:defer-deadline 10.0 c))))) + (sb-sys:with-deadline (:seconds 0.1) + (sb-thread:with-mutex (mutex) + (sb-thread:condition-wait waitq mutex)))))))) (push child threads))) (mapc #'sb-thread:join-thread threads) (assert (not deadline-handler-run-twice?)))) (with-test (:name (:condition-wait :signal-deadline-with-interrupts-enabled)) - #+darwin - (error "Bad Darwin") (let ((mutex (sb-thread:make-mutex)) (waitq (sb-thread:make-waitqueue)) (A-holds? :unknown) @@ -1129,7 +1127,8 @@ (sb-sys:defer-deadline 10.0 c)))) (sb-sys:with-deadline (:seconds 0.1) (sb-thread:with-mutex (mutex) - (sb-thread:condition-wait waitq mutex))))))) + (sb-thread:condition-wait waitq mutex))))) + :name "A")) (setq B (sb-thread:make-thread #'(lambda () (thread-yield) @@ -1148,7 +1147,8 @@ (sb-sys:defer-deadline 10.0 c)))) (sb-sys:with-deadline (:seconds 0.1) (sb-thread:with-mutex (mutex) - (sb-thread:condition-wait waitq mutex))))))) + (sb-thread:condition-wait waitq mutex))))) + :name "B")) (sb-thread:join-thread A) (sb-thread:join-thread B) (let ((A-result (list A-holds? A-interrupts-enabled?)) @@ -1160,7 +1160,10 @@ ;; behaviour. (cond ((equal A-result '(t t)) (assert (equal B-result '(nil t)))) ((equal B-result '(t t)) (assert (equal A-result '(nil t)))) - (t (error "Failure: fall through.")))))) + (t + (error "Failure: fell through wit A: ~S, B: ~S" + A-result + B-result)))))) (with-test (:name (:mutex :finalization)) (let ((a nil)) @@ -1202,9 +1205,7 @@ (format t "infodb test done~%") -(with-test (:name (:backtrace)) - #+darwin - (error "Prone to crash on Darwin, cause unknown.") +(with-test (:name :backtrace) ;; Printing backtraces from several threads at once used to hang the ;; whole SBCL process (discovered by accident due to a timer.impure ;; test misbehaving). The cause was that packages weren't even @@ -1223,9 +1224,9 @@ (format t "~&starting gc deadlock test: WARNING: THIS TEST WILL HANG ON FAILURE!~%") -(with-test (:name (:gc-deadlock)) - #+darwin - (error "Prone to hang on Darwin due to interrupt issues.") +(with-test (:name :gc-deadlock + ;; Prone to hang on Darwin due to interrupt issues. + :broken-on :darwin) ;; Prior to 0.9.16.46 thread exit potentially deadlocked the ;; GC due to *all-threads-lock* and session lock. On earlier ;; versions and at least on one specific box this test is good enough