(3 nil (#\1 #\2 #\3) nil)
(0 t nil t))
-#+sb-thread
+;;; FIXME: Several tests disabled on Darwin due to hangs. Something not right
+;;; with mailboxes -- or possibly semaphores -- there.
+#+(and sb-thread (not darwin))
(progn
;; Dummy struct for ATOMIC-INCF to work.
#!+sb-doc
"Deprecated in favor of GRAB-MUTEX."
(declare (type mutex mutex) (optimize (speed 3))
- #!-sb-thread (ignore waitp timeout)
- #!+sb-lutex (ignore timeout))
+ #!-sb-thread (ignore waitp timeout))
(unless new-owner
(setq new-owner *current-thread*))
(let ((old (mutex-%owner mutex)))
;; but has that been checked?) (2) after the lutex call, but
;; before setting the mutex owner.
#!+sb-lutex
- (when (zerop (with-lutex-address (lutex (mutex-lutex mutex))
- (if waitp
- (with-interrupts (%lutex-lock lutex))
- (%lutex-trylock lutex))))
- (setf (mutex-%owner mutex) new-owner)
- t)
+ (progn
+ (when timeout
+ (error "Mutex timeouts not supported on this platform."))
+ (when (zerop (with-lutex-address (lutex (mutex-lutex mutex))
+ (if waitp
+ (with-interrupts (%lutex-lock lutex))
+ (%lutex-trylock lutex))))
+ (setf (mutex-%owner mutex) new-owner)
+ t))
#!-sb-lutex
;; This is a direct translation of the Mutex 2 algorithm from
;; "Futexes are Tricky" by Ulrich Drepper.
If TIMEOUT is given, it specifies a relative timeout, in seconds, on
how long GRAB-MUTEX should try to acquire the lock in the contested
-case.
+case. Unsupported on :SB-LUTEX platforms (eg. Darwin), where a non-NIL
+TIMEOUT signals an error.
If GRAB-MUTEX returns T, the lock acquisition was successful. In case
of WAITP being NIL, or an expired TIMEOUT, GRAB-MUTEX may also return
ALLOW-WITH-INTERRUPTS allows the call to be interrupted from
sleep.
- - The TIMEOUT parameter is currently only supported on non-SB-LUTEX
- platforms like Linux or BSD.
-
- (GRAB-MUTEX <mutex> :timeout 0.0) differs from
(GRAB-MUTEX <mutex> :waitp nil) in that the former may signal a
DEADLINE-TIMEOUT if the global deadline was due already on
;; forked process' signal mask to defaults. But the default is `stop'
;; of which we can be notified asynchronously by providing a status hook.
(with-test (:name (:run-program :inherit-stdin))
+ #+(and darwin sb-thread)
+ (error "Hangs on threaded Darwin.")
(let (stopped)
(flet ((status-hook (proc)
(case (sb-ext:process-status proc)
(append-failures)))
(defun run-in-child-sbcl (load-forms forms)
- (declare (ignorable load-forms))
- #-win32
- (let ((pid (sb-posix:fork)))
- (cond ((= pid 0)
- (dolist (form forms)
- (eval form)))
- (t
- (let ((status (make-array 1 :element-type '(signed-byte 32))))
- (sb-posix:waitpid pid 0 status)
- (if (sb-posix:wifexited (aref status 0))
- (sb-posix:wexitstatus (aref status 0))
- 1)))))
- #+win32
+ ;; We used to fork() for POSIX platforms, and use this for Windows.
+ ;; However, it seems better to use the same solution everywhere.
(process-exit-code
(sb-ext:run-program
(first *POSIX-ARGV*)
(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)))
(with-mutex (m)
(assert (null (join-thread (make-thread
(grab-mutex m :timeout 0.1)))))))))
(with-test (:name (:grab-mutex :timeout :acquisition-success))
+ #+sb-lutex
+ (error "Mutex timeout not supported here.")
(let ((m (make-mutex))
(child))
(with-mutex (m)
(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)))
(with-mutex (m)
(assert (eq (join-thread
: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
(defun alloc-stuff () (copy-list '(1 2 3 4 5)))
(with-test (:name (:interrupt-thread :interrupt-consing-child))
+ #+darwin
+ (error "Hangs on Darwin.")
(let ((thread (sb-thread:make-thread (lambda () (loop (alloc-stuff))))))
(let ((killers
(loop repeat 4 collect
(format t "~&multi interrupt test done~%")
(with-test (:name (:interrupt-thread :interrupt-consing-child :again))
+ #+darwin
+ (error "Hangs on Darwin.")
(let ((c (make-thread (lambda () (loop (alloc-stuff))))))
;; NB this only works on x86: other ports don't have a symbol for
;; pseudo-atomic atomicity
(assert (sb-thread:join-thread thread))))
(with-test (:name (:two-threads-running-gc))
+ #+darwin
+ (error "Hangs on Darwin.")
(let (a-done b-done)
(make-thread (lambda ()
(dotimes (i 100)
(format t "~&multiple reader hash table test done~%")
(with-test (:name (:hash-table-single-accessor-parallel-gc))
+ #+darwin
+ (error "Prone to hang on Darwin due to interrupt issues.")
(let ((hash (make-hash-table))
(*errors* nil))
(let ((threads (list (sb-thread:make-thread
(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)
(format t "infodb test done~%")
(with-test (:name (:backtrace))
+ #+darwin
+ (error "Prone to crash on Darwin, cause unknown.")
;; 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
(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.")
;; 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
;;; before they ran) and dying threads were open interrupts.
#+sb-thread
(with-test (:name (:timer :parallel-unschedule))
+ #+darwin
+ (error "Prone to hang on Darwin due to interrupt issues.")
(let ((timer (sb-ext:make-timer (lambda () 42) :name "parallel schedulers"))
(other nil))
(flet ((flop ()
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.46"
+"1.0.37.47"
projects / sbcl.git / commitdiff