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

Optional prefix message to exception, so we dont lose information from

Browse Source 
exceptions.  For example, in (module foo scheme/lang ...) we should
still see the real error message.

svn: r10510
This commit is contained in:
Eli Barzilay 2008-06-29 22:54:51 +00:00
parent f2fdb531a6
commit 9a900b37aa
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/drscheme/private/module-language.ss
View File

@ -145,12 +145,9 @@
(let ([super-result (let ([super-result
;; just reading the definitions might be a syntax error, ;; just reading the definitions might be a syntax error,
;; possibly due to bad language (eg, no foo/lang/reader) ;; possibly due to bad language (eg, no foo/lang/reader)
(with-handlers (with-handlers ([exn? (λ (e)
([exn? (λ (e) (raise-hopeless-exception
(fprintf (current-error-port) e "invalid module text"))])
"Module Language: ~a\n"
"invalid module text")
(raise-hopeless-exception e))])
(super-thunk))]) (super-thunk))])
(if (eof-object? super-result) (if (eof-object? super-result)
(raise-hopeless-syntax-error) (raise-hopeless-syntax-error)
@ -230,7 +227,7 @@
[language-numbers (list -32768)]))) [language-numbers (list -32768)])))
(define hopeless-repl (make-thread-cell #t)) (define hopeless-repl (make-thread-cell #t))
(define (raise-hopeless-exception exn) (define (raise-hopeless-exception exn [prefix #f])
(define rep (drscheme:rep:current-rep)) (define rep (drscheme:rep:current-rep))
;; MINOR HACK: since this is a value that is used by the drscheme thread, ;; MINOR HACK: since this is a value that is used by the drscheme thread,
;; Robby says it's better to set it while in that thread. This requires ;; Robby says it's better to set it while in that thread. This requires
@ -238,6 +235,8 @@
;; `drscheme:init:system-eventspace', or make `queue-system-callback/sync' ;; `drscheme:init:system-eventspace', or make `queue-system-callback/sync'
;; into a public method (accessible here). ;; into a public method (accessible here).
(send rep set-show-no-user-evaluation-message? #f) (send rep set-show-no-user-evaluation-message? #f)
(when prefix
(fprintf (current-error-port) "Module Language: ~a\n" prefix))
((error-display-handler) (exn-message exn) exn) ((error-display-handler) (exn-message exn) exn)
(send rep insert-warning "\n[Interactions disabled]") (send rep insert-warning "\n[Interactions disabled]")
(custodian-shutdown-all (send rep get-user-custodian))) (custodian-shutdown-all (send rep get-user-custodian)))
@ -444,8 +443,7 @@
;; probably best to not say anything here ;; probably best to not say anything here
;; (send rep insert-warning "Definitions not in effect") ;; (send rep insert-warning "Definitions not in effect")
lang-only) lang-only)
(raise-hopeless-syntax-error "bad language specification" (raise-hopeless-exception exn "invalid language specification"))))
stx lang))))
;; Expand the module expression, so we can catch an syntax errors and ;; Expand the module expression, so we can catch an syntax errors and
;; provide a repl with the base language in that case. ;; provide a repl with the base language in that case.
(with-handlers ([exn? only-language]) (with-handlers ([exn? only-language])