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

fix bug in online check syntax's save file notification

Browse Source 
Before this commit, the files that are loaded during expansion
were discarded when an error during expansion occurs. This commit
saves them: unless the program is something like

  (begin-for-syntax (kill-thread (current-thread)))

the handling that deals with that kind of situation (as opposed
to just an exception being raised) doesn't try to save them

Do not merge to 5.3.2: this bug isn't serious and the new code
is not as well tested as the old
This commit is contained in:
Robby Findler 2013-01-15 08:59:52 -06:00
parent a5daacd747
commit c8a1ec8c9c
2 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/drracket/private/expanding-place.rkt
View File

@ -109,6 +109,7 @@
(ep-log-info "expanding-place.rkt: 05 installing security guard")
(install-security-guard) ;; must come after the call to set-module-language-parameters
(ep-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(define loaded-paths '())
(uncaught-exception-handler
(λ (exn)
(parameterize ([current-custodian orig-cust])
@ -116,7 +117,7 @@
(λ ()
(stop-watching-abnormal-termination)
(semaphore-post sema)
(channel-put exn-chan exn))))
(channel-put exn-chan (list exn loaded-paths)))))
(semaphore-wait sema)
((error-escape-handler))))
(ep-log-info "expanding-place.rkt: 07 starting read-syntax")
@ -138,7 +139,6 @@
(when log-io?
(thread (λ () (catch-and-log in io-sema))))
(define original-path (make-parameter #f))
(define loaded-paths '())
(define expanded
(parameterize ([current-output-port out]
[current-error-port out]
@ -210,16 +210,20 @@
;; note: this message is actually ignored: a string
;; constant is used back in the drracket place
"Expansion thread terminated unexpectedly"
'()
;; give up on dep paths in this case:
'()))))
(handle-evt
result-chan
(λ (val+loaded-files)
(λ (val+loaded-paths)
(place-channel-put response-pc (vector 'handler-results
(list-ref val+loaded-files 0)
(list-ref val+loaded-files 1)))))
(list-ref val+loaded-paths 0)
(list-ref val+loaded-paths 1)))))
(handle-evt
exn-chan
(λ (exn)
(λ (exn+loaded-paths)
(define exn (list-ref exn+loaded-paths 0))
(place-channel-put
response-pc
(vector
@ -249,7 +253,8 @@
(srcloc-span srcloc)))
<
#:key (λ (x) (vector-ref x 0)))
'()))))))))
'())
(list-ref exn+loaded-paths 1))))))))
(define (stop-watching-abnormal-termination)
(channel-put normal-termination #t))

13
collects/drracket/private/module-language.rkt
View File

@ -1937,7 +1937,7 @@
val))))
(send running-tab set-oc-status (clean #f #f '()))
(send running-tab set-dep-paths (vector-ref res 2))]
(send running-tab set-dep-paths (list->set (vector-ref res 2)))]
[else
(line-of-interest)
(send running-tab set-oc-status
@ -1945,7 +1945,8 @@
(if (eq? (vector-ref res 0) 'abnormal-termination)
sc-abnormal-termination
(vector-ref res 1))
(vector-ref res 2)))])
(vector-ref res 2)))
(send running-tab set-dep-paths (list->set (vector-ref res 3)))])
(oc-maybe-start-something)))
(define/oc-log (oc-status-message sym str)
@ -2018,19 +2019,13 @@
'finished-expansion
sc-online-expansion-running))))))
(define res (place-channel-get pc-out))
(define res/set
(if (eq? (vector-ref res 0) 'handler-results)
(vector (vector-ref res 0)
(vector-ref res 1)
(list->set (vector-ref res 2)))
res))
(queue-callback
(λ ()
(when (eq? us pending-thread)
(set-pending-thread #f #f))
(when (getenv "PLTDRPLACEPRINT")
(printf "PLTDRPLACEPRINT: got results back from the place\n"))
(show-results res/set)))))))
(show-results res)))))))
(define (stop-place-running)
(when expanding-place