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

fix a bug in the kill-safe abstraction that is designed to protect

Browse Source 
the state that online check syntax uses (indirectly via scribble)
to lookup documentation.

since the kill-safe abstraction moved some computation over to
another thread, the values of various parameters (current-directory
in this case) were not preserved. So when scribble then ended up
resolving a module path with the wrong current directory, this
bad value got cached. Then later, when check syntax tries to figure
out what file to open to jump to it, it got the cached bogus value
(even though current-directory was right when check syntax asked
for the filename).

closes PR 12538
This commit is contained in:
Robby Findler 2011-12-15 20:30:43 -06:00
parent a2bbcf8b00
commit a122ea725d
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/drracket/private/syncheck/xref.rkt
View File

@ -22,19 +22,20 @@
(thread
(λ ()
(let loop ()
(define-values (binding-info resp-chan nack-evt) (apply values (channel-get req-chan)))
(define xref (force delayed-xref))
(define-values (binding-info cd resp-chan nack-evt) (apply values (channel-get req-chan)))
(define resp
(and xref
(let ([definition-tag (xref-binding->definition-tag xref binding-info #f)])
(and definition-tag
(let-values ([(path tag) (xref-tag->path+anchor xref definition-tag)])
(and path
(let ([index-entry (xref-tag->index-entry xref definition-tag)])
(and index-entry
(list (entry-desc index-entry)
path
tag)))))))))
(parameterize ([current-directory cd])
(define xref (force delayed-xref))
(and xref
(let ([definition-tag (xref-binding->definition-tag xref binding-info #f)])
(and definition-tag
(let-values ([(path tag) (xref-tag->path+anchor xref definition-tag)])
(and path
(let ([index-entry (xref-tag->index-entry xref definition-tag)])
(and index-entry
(list (entry-desc index-entry)
path
tag))))))))))
(thread
(λ ()
(sync (channel-put-evt resp-chan resp)
@ -50,5 +51,5 @@
(nack-guard-evt
(λ (nack-evt)
(define resp-chan (make-channel))
(channel-put req-chan (list binding-info resp-chan nack-evt))
(channel-put req-chan (list binding-info (current-directory) resp-chan nack-evt))
resp-chan)))))