cs: prevent a future from waiting on a semaphore
A `semaphore-wait` or `semaphore-post` has a shortcut that uses a CAS operation, which means that a future could affect a semaphore if it's allowed to take that shortcut. But futures aren't supposed to succeed in that way, because thread-level synchronization should generally suspend a future. Disallow the shortcut when in a future.
This commit is contained in:
parent
e56d8c5ded
commit
b09e10d066
31
pkgs/racket-test/tests/future/hash-lock.rkt
Normal file
31
pkgs/racket-test/tests/future/hash-lock.rkt
Normal file
|
@ -0,0 +1,31 @@
|
|||
#lang racket/base
|
||||
(require racket/future)
|
||||
|
||||
;; Check that a future won't take a lock on an `equal?`-based hash
|
||||
;; table and then leave the table stuck as the future is suspended.
|
||||
;; Indirectly, that's checking that a future won't succeed waiting
|
||||
;; on a semaphore, since a semaphore is used as a lock.
|
||||
|
||||
(struct a (x)
|
||||
#:property
|
||||
prop:equal+hash
|
||||
(list
|
||||
(lambda (a b eql?)
|
||||
(sync (system-idle-evt))
|
||||
(eql? (a-x a) (a-x b)))
|
||||
(lambda (a hc)
|
||||
(sync (system-idle-evt))
|
||||
(hc (a-x a)))
|
||||
(lambda (a hc)
|
||||
(hc (a-x a)))))
|
||||
|
||||
(define ht (make-hash (list
|
||||
(cons (a 1) 'one)
|
||||
(cons (a 2) 'two))))
|
||||
|
||||
(define f (future
|
||||
(lambda ()
|
||||
(hash-ref ht (a 1) #f))))
|
||||
(sync (system-idle-evt))
|
||||
(unless (eq? (hash-ref ht (a 1) #f) 'one)
|
||||
(error "hash failed"))
|
|
@ -4348,7 +4348,11 @@
|
|||
(define unsafe-semaphore-post
|
||||
(lambda (s_0)
|
||||
(let ((c_0 (semaphore-count s_0)))
|
||||
(if (if (>= c_0 0) (unsafe-struct*-cas! s_0 2 c_0 (add1 c_0)) #f)
|
||||
(if (if (>= c_0 0)
|
||||
(if (not (current-future$1))
|
||||
(unsafe-struct*-cas! s_0 2 c_0 (add1 c_0))
|
||||
#f)
|
||||
#f)
|
||||
(void)
|
||||
(begin (start-atomic) (semaphore-post/atomic s_0) (end-atomic))))))
|
||||
(define semaphore-post/atomic
|
||||
|
@ -4417,7 +4421,11 @@
|
|||
(define unsafe-semaphore-wait
|
||||
(lambda (s_0)
|
||||
(let ((c_0 (semaphore-count s_0)))
|
||||
(if (if (positive? c_0) (unsafe-struct*-cas! s_0 2 c_0 (sub1 c_0)) #f)
|
||||
(if (if (positive? c_0)
|
||||
(if (not (current-future$1))
|
||||
(unsafe-struct*-cas! s_0 2 c_0 (sub1 c_0))
|
||||
#f)
|
||||
#f)
|
||||
(void)
|
||||
(|#%app|
|
||||
(begin
|
||||
|
|
|
@ -71,6 +71,7 @@
|
|||
(define c (semaphore-count s))
|
||||
(cond
|
||||
[(and (c . >= . 0)
|
||||
(not (current-future))
|
||||
(unsafe-struct*-cas! s count-field-pos c (add1 c)))
|
||||
(void)]
|
||||
[else
|
||||
|
@ -132,6 +133,7 @@
|
|||
(define c (semaphore-count s))
|
||||
(cond
|
||||
[(and (positive? c)
|
||||
(not (current-future))
|
||||
(unsafe-struct*-cas! s count-field-pos c (sub1 c)))
|
||||
(void)]
|
||||
[else
|
||||
|
|
Loading…
Reference in New Issue
Block a user