add more detail to the hopefully-help-me-debug log messages that drracket reports about the online check syntax bug

This commit is contained in:
Robby Findler 2011-08-05 15:46:46 -07:00
parent a090a0e903
commit eeb79e0e48

View File

@ -60,19 +60,24 @@
(parameterize ([current-custodian cust]) (parameterize ([current-custodian cust])
(thread (thread
(λ () (λ ()
(log-info "expanding-place.rkt: starting thread") (log-info "expanding-place.rkt: 01 starting thread")
(define sema (make-semaphore 0)) (define sema (make-semaphore 0))
(log-info "expanding-place.rkt: 02 setting basic parameters")
(set-basic-parameters/no-gui) (set-basic-parameters/no-gui)
(log-info "expanding-place.rkt: 03 setting module language parameters")
(set-module-language-parameters settings (set-module-language-parameters settings
module-language-parallel-lock-client module-language-parallel-lock-client
#:use-use-current-security-guard? #t) #:use-use-current-security-guard? #t)
(log-info "expanding-place.rkt: 04 setting directories")
(when path (when path
(let-values ([(base name dir?) (split-path path)]) (let-values ([(base name dir?) (split-path path)])
(current-directory base) (current-directory base)
(current-load-relative-directory base))) (current-load-relative-directory base)))
(define sp (open-input-string program-as-string)) (define sp (open-input-string program-as-string))
(port-count-lines! sp) (port-count-lines! sp)
(log-info "expanding-place.rkt: 05 installing security guard")
(install-security-guard) ;; must come after the call to set-module-language-parameters (install-security-guard) ;; must come after the call to set-module-language-parameters
(log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(uncaught-exception-handler (uncaught-exception-handler
(λ (exn) (λ (exn)
(parameterize ([current-custodian orig-cust]) (parameterize ([current-custodian orig-cust])
@ -83,33 +88,34 @@
(channel-put exn-chan exn)))) (channel-put exn-chan exn))))
(semaphore-wait sema) (semaphore-wait sema)
((error-escape-handler)))) ((error-escape-handler))))
(log-info "expanding-place.rkt: starting read-syntax") (log-info "expanding-place.rkt: 07 starting read-syntax")
(define stx (define stx
(parameterize ([read-accept-reader #t]) (parameterize ([read-accept-reader #t])
(read-syntax the-source sp))) (read-syntax the-source sp)))
(log-info "expanding-place.rkt: read") (log-info "expanding-place.rkt: 08 read")
(when (syntax? stx) ;; could be eof (when (syntax? stx) ;; could be eof
(define-values (name lang transformed-stx) (define-values (name lang transformed-stx)
(transform-module path (transform-module path
(namespace-syntax-introduce stx) (namespace-syntax-introduce stx)
raise-hopeless-syntax-error)) raise-hopeless-syntax-error))
(log-info "expanding-place.rkt: starting expansion") (log-info "expanding-place.rkt: 09 starting expansion")
(define expanded (expand transformed-stx)) (define expanded (expand transformed-stx))
(log-info "expanding-place.rkt: expanded") (log-info "expanding-place.rkt: 10 expanded")
(define handler-results (define handler-results
(for/list ([handler (in-list handlers)]) (for/list ([handler (in-list handlers)])
(list (handler-key handler) (list (handler-key handler)
((handler-proc handler) expanded ((handler-proc handler) expanded
path path
the-source)))) the-source))))
(log-info "expanding-place.rkt: handlers finished") (log-info "expanding-place.rkt: 11 handlers finished")
(parameterize ([current-custodian orig-cust]) (parameterize ([current-custodian orig-cust])
(thread (thread
(λ () (λ ()
(channel-put normal-termination #t) (channel-put normal-termination #t)
(semaphore-post sema) (semaphore-post sema)
(channel-put result-chan handler-results)))) (channel-put result-chan handler-results))))
(semaphore-wait sema)))))) (semaphore-wait sema)
(log-info "expanding-place.rkt: 12 finished"))))))
(thread (thread
(λ () (λ ()