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

Report errors during expansion in the interactions window, not as internal errors.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-21 16:55:58 -04:00
parent b305ea9c62
commit 58fbd8ba75
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/typed-scheme/optimizer/tool/report.rkt
View File

@ -41,12 +41,19 @@
;; expand and capture log messages ;; expand and capture log messages
(define listener #f) (define listener #f)
(define exception #f)
(define done-chan (make-channel)) (define done-chan (make-channel))
(drracket:eval:expand-program (drracket:eval:expand-program
(drracket:language:make-text/pos (drracket:language:make-text/pos
this 0 (send this last-position)) this 0 (send this last-position))
(send this get-next-settings) #t (send this get-next-settings) #t
(lambda () (set! listener (start-recording #:level 'warning))) (lambda () ; init
(uncaught-exception-handler
(lambda (e)
(set! exception e) ; something went wrong, save exception and die
(channel-put done-chan 'done) ; let the rest of the program carry on
(custodian-shutdown-all (current-custodian)))) ; kill ourselves
(set! listener (start-recording #:level 'warning)))
void ; kill void ; kill
(lambda (term k) (lambda (term k)
(if (eof-object? term) (if (eof-object? term)
@ -55,6 +62,9 @@
(k)))) ; not done, keep going (k)))) ; not done, keep going
(channel-get done-chan) ; wait for expansion to finish (channel-get done-chan) ; wait for expansion to finish
(when exception ; something went wrong, will be caught upstream
(raise exception))
(define (post-process-log-entry l) (define (post-process-log-entry l)
;; make sure the message is indeed from the optimizer ;; make sure the message is indeed from the optimizer
(cond [(log-message-from-tr-opt? l) (cond [(log-message-from-tr-opt? l)