suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/promise: repairs for custodian change

Browse Source 
Closes #2973

Note that the test is in the "lazy" package, commit 2cc3a24343.
This commit is contained in:
Matthew Flatt 2019-12-16 08:58:08 -07:00
parent 15c0e34bed
commit 2d695be78c
1 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
racket/collects/racket/promise.rkt
View File

@ -117,11 +117,15 @@
(thread-group? group)) (thread-group? group))
(raise-argument-error 'delay/thread "(or/c thread-group? #f)" group)) (raise-argument-error 'delay/thread "(or/c thread-group? #f)" group))
(define initialized-sema (make-semaphore)) (define initialized-sema (make-semaphore))
(define orig-c (current-custodian))
(define (run) (define (run)
(semaphore-wait initialized-sema) ; wait until p is properly defined (semaphore-wait initialized-sema) ; wait until p is properly defined
(call-with-exception-handler (call-with-exception-handler
(λ(e) (pset! p (make-reraise e)) (kill-thread (current-thread))) (λ (e)
(λ() (pset! p (call-with-values thunk list))))) (pset! p (make-reraise e))
(parameterize ([current-custodian orig-c])
(kill-thread (current-thread))))
(λ () (pset! p (call-with-values thunk list)))))
(define p (define p
(make-promise/thread (make-promise/thread
(make-running-thread (make-running-thread
@ -164,10 +168,14 @@
(define use (cond [(use* . <= . 0) 0] [(use* . >= . 1) 1] [else use*])) (define use (cond [(use* . <= . 0) 0] [(use* . >= . 1) 1] [else use*]))
(define work-time (* tick use)) (define work-time (* tick use))
(define rest-time (- tick work-time)) (define rest-time (- tick work-time))
(define orig-c (current-custodian))
(define (work) (define (work)
(call-with-exception-handler (call-with-exception-handler
(λ(e) (pset! p (make-reraise e)) (kill-thread (current-thread))) (λ (e)
(λ() (pset! p (call-with-values thunk list))))) (pset! p (make-reraise e))
(parameterize ([current-custodian orig-c])
(kill-thread (current-thread))))
(λ () (pset! p (call-with-values thunk list)))))
(define (run) (define (run)
;; this thread is dedicated to controlling the worker thread, so it's ;; this thread is dedicated to controlling the worker thread, so it's
;; possible to dedicate messages to signaling a `force'. ;; possible to dedicate messages to signaling a `force'.