From 374667fd8a38e79869e63d56bacde7ad98a40852 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 7 Apr 2010 11:58:59 +0000 Subject: [PATCH] 1.0.37.47: less pain for building threads on Darwin * Use RUN-PROGRAM for impure tests everywhere. Not only is it better to use the more-portable solution everywhere, we had a huge number of bogus failures on thread tests on Darwin due to interactions between fork() and thread stack cleanup. Addresses Launchpad bug #310208. * Make tests depending on mutex timeout punt on lutex platform, and make several test which are prone hang or crash into LDB punt on Darwin. ("Punt" here means "call ERROR" so we get a test failure.) * Disable mailbox tests prone to hang on Darwin. ...so building threads on Darwin means one actually has a prayer or running the tests with useful results -- and the failures are real Darwin problems. --- contrib/sb-concurrency/tests/test-mailbox.lisp | 4 +++- src/code/target-thread.lisp | 24 ++++++++++++------------ tests/run-program.impure.lisp | 2 ++ tests/run-tests.lisp | 15 ++------------- tests/threads.impure.lisp | 22 ++++++++++++++++++++++ tests/timer.impure.lisp | 2 ++ version.lisp-expr | 2 +- 7 files changed, 44 insertions(+), 27 deletions(-) diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp index f69628a1c..a0f0386f5 100644 --- a/contrib/sb-concurrency/tests/test-mailbox.lisp +++ b/contrib/sb-concurrency/tests/test-mailbox.lisp @@ -38,7 +38,9 @@ (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. diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 9ab61b18f..8c7c1fec9 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -361,8 +361,7 @@ HOLDING-MUTEX-P." #!+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))) @@ -385,12 +384,15 @@ HOLDING-MUTEX-P." ;; 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. @@ -444,7 +446,8 @@ non-NIL and the mutex is in use, sleep until it is available. 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 @@ -468,9 +471,6 @@ Notes: 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 :timeout 0.0) differs from (GRAB-MUTEX :waitp nil) in that the former may signal a DEADLINE-TIMEOUT if the global deadline was due already on diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index f02cfa08d..edae1fb8d 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -154,6 +154,8 @@ ;; 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) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index bcd090db8..67ba2746f 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -78,19 +78,8 @@ (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*) diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index a56f01fe3..0e43d628f 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -346,6 +346,8 @@ (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 @@ -353,6 +355,8 @@ (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) @@ -361,6 +365,8 @@ (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 @@ -373,6 +379,8 @@ :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 @@ -555,6 +563,8 @@ (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 @@ -573,6 +583,8 @@ (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 @@ -660,6 +672,8 @@ (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) @@ -981,6 +995,8 @@ (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 @@ -1088,6 +1104,8 @@ (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) @@ -1187,6 +1205,8 @@ (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 @@ -1206,6 +1226,8 @@ (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 diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp index c478eb336..df6c7ec59 100644 --- a/tests/timer.impure.lisp +++ b/tests/timer.impure.lisp @@ -241,6 +241,8 @@ ;;; 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 () diff --git a/version.lisp-expr b/version.lisp-expr index 7b98a826e..56a62a34c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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" -- 2.11.4.GIT