fix a leak in DrRacket
It was leaking threads at about the rate of 2 per online expansion that had a syntax error (or otherwise aborted without finishing expansion)
This commit is contained in:
parent
5937bcbbf5
commit
7b0608ca42
|
@ -171,7 +171,7 @@
|
|||
(semaphore-wait io-sema))
|
||||
(channel-put old-registry-chan
|
||||
(namespace-module-registry (current-namespace)))
|
||||
(place-channel-put pc-status-expanding-place (void))
|
||||
(place-channel-put pc-status-expanding-place 'finished-expansion)
|
||||
(ep-log-info "expanding-place.rkt: 10 expanded")
|
||||
(define handler-results
|
||||
(for/list ([handler (in-list handlers)])
|
||||
|
@ -213,6 +213,8 @@
|
|||
(handle-evt
|
||||
abnormal-termination
|
||||
(λ (val)
|
||||
(place-channel-put pc-status-expanding-place
|
||||
'abnormal-termination)
|
||||
(place-channel-put
|
||||
response-pc
|
||||
(vector 'abnormal-termination
|
||||
|
@ -232,6 +234,7 @@
|
|||
(handle-evt
|
||||
exn-chan
|
||||
(λ (exn+loaded-paths)
|
||||
(place-channel-put pc-status-expanding-place 'exn-raised)
|
||||
(define exn (list-ref exn+loaded-paths 0))
|
||||
(place-channel-put
|
||||
response-pc
|
||||
|
|
|
@ -2016,13 +2016,17 @@
|
|||
(define us (current-thread))
|
||||
(thread (λ ()
|
||||
(define got-status-update (place-channel-get pc-status-drracket-place))
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when (and (eq? us pending-thread)
|
||||
pending-tell-the-tab-show-bkg-running)
|
||||
(pending-tell-the-tab-show-bkg-running
|
||||
'finished-expansion
|
||||
sc-online-expansion-running))))))
|
||||
;; when got-status-update isn't 'finished-expansion, then
|
||||
;; that means that expansion won't ever finish (due to
|
||||
;; an error or an aborted job)
|
||||
(when (equal? got-status-update 'finished-expansion)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when (and (eq? us pending-thread)
|
||||
pending-tell-the-tab-show-bkg-running)
|
||||
(pending-tell-the-tab-show-bkg-running
|
||||
'finished-expansion
|
||||
sc-online-expansion-running)))))))
|
||||
(define res (place-channel-get pc-out))
|
||||
(queue-callback
|
||||
(λ ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user