From 5e55f426de8fa579a0d6cfbfb3ac5433d530d3c9 Mon Sep 17 00:00:00 2001 From: "Tobias C. Rittweiler" Date: Mon, 1 Feb 2010 18:55:13 +0000 Subject: [PATCH] 1.0.35.2: Fix CONDITION-WAIT to signal deadline with interrupts enabled. --- NEWS | 8 ++++-- src/code/target-thread.lisp | 3 ++- tests/threads.impure.lisp | 59 +++++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 68 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index aeb9409..adf8eaf 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,11 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- changes relative to sbcl-1.0.35: - * bug fix: SB-THREAD:CONDITION-WAIT sometimes signaled a deadline twice - in a row even though a handler defered it long into the future. + * bug fix: SB-THREAD:CONDITION-WAIT sometimes signaled a deadline twice + in a row even though a handler defered the deadline long into the + future. (lp#512914) + * bug fix: a deadline handler was run without interrupts enabled for a + deadline signaled within SB-THREAD:CONDITION-WAIT. That could result + in infinitely spinning, non-killable threads. changes in sbcl-1.0.35 relative to sbcl-1.0.34: * optimization: ROUND with a single single-float or double-float argument diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 3496854..c3cdf38 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -556,7 +556,8 @@ time we reacquire MUTEX and return to the caller." ;; continuing after a deadline or EINTR. (setf (waitqueue-data queue) me) (loop - (multiple-value-bind (to-sec to-usec) (decode-timeout nil) + (multiple-value-bind (to-sec to-usec) + (allow-with-interrupts (decode-timeout nil)) (case (unwind-protect (with-pinned-objects (queue me) ;; RELEASE-MUTEX is purposefully as close to diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 7190df5..f32588e 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -967,6 +967,65 @@ (mapc #'sb-thread:join-thread threads) (assert (not deadline-handler-run-twice?)))) +(with-test (:name (:condition-wait :signal-deadline-with-interrupts-enabled)) + (let ((mutex (sb-thread:make-mutex)) + (waitq (sb-thread:make-waitqueue)) + (A-holds? :unknown) + (B-holds? :unknown) + (A-interrupts-enabled? :unknown) + (B-interrupts-enabled? :unknown) + (A) + (B)) + ;; W.L.O.G., we assume that A is executed first... + (setq A (sb-thread:make-thread + #'(lambda () + (handler-bind + ((sb-sys:deadline-timeout + #'(lambda (c) + ;; We came here through the call to DECODE-TIMEOUT + ;; in CONDITION-WAIT; hence both here are supposed + ;; to evaluate to T. + (setq A-holds? (sb-thread:holding-mutex-p mutex)) + (setq A-interrupts-enabled? + sb-sys:*interrupts-enabled*) + (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))))))) + (setq B (sb-thread:make-thread + #'(lambda () + (thread-yield) + (handler-bind + ((sb-sys:deadline-timeout + #'(lambda (c) + ;; We came here through the call to GET-MUTEX + ;; in CONDITION-WAIT (contended case of + ;; reaquiring the mutex) - so the former will + ;; be NIL, but interrupts should still be enabled. + (setq B-holds? (sb-thread:holding-mutex-p mutex)) + (setq B-interrupts-enabled? + sb-sys:*interrupts-enabled*) + (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:join-thread A) + (sb-thread:join-thread B) + (let ((A-result (list A-holds? A-interrupts-enabled?)) + (B-result (list B-holds? B-interrupts-enabled?))) + ;; We also check some subtle behaviour w.r.t. whether a deadline + ;; handler in CONDITION-WAIT got the mutex, or not. This is most + ;; probably very internal behaviour (so user should not depend + ;; on it) -- I added the testing here just to manifest current + ;; 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.")))))) + (with-test (:name (:mutex :finalization)) (let ((a nil)) (dotimes (i 500000) diff --git a/version.lisp-expr b/version.lisp-expr index 0f14dec..ff405e3 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.35.1" +"1.0.35.2" -- 1.7.10.4