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:
parent
a090a0e903
commit
eeb79e0e48
|
@ -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
|
||||||
(λ ()
|
(λ ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user