raco setup: improve and normalize error reporting
When repoting an error during compilation, always show the path to the module being compiled. That path was sometimes available in the error message anyway, due to source locations for syntax errors, but often there would be no path due to run-time errors in macros, a lack of source locations on macro-introduced forms, etc. The `raco setup` improvements rely on new machinery in `compiler/cm`, and `raco make` inherits that machinery. The parallel and non-parallel variants of `raco setup` reported excpetions in slightly different formats, and now they're consistent. The initial report of an exception now always shows an evaluation context, while the summary's repeat of the error omits the context.
This commit is contained in:
parent
1c4c76dd57
commit
17275b946a
|
@ -258,6 +258,8 @@ the security guard in the @racket[current-security-guard] when
|
|||
the files are created is used (not the security guard at the point
|
||||
@racket[make-compilation-manager-load/use-compiled-handler] is called).
|
||||
|
||||
The continuation the compilation of a module is marked with a
|
||||
@racket[managed-compiled-context-key] and the module's source path.
|
||||
|
||||
@emph{Do not} install the result of
|
||||
@racket[make-compilation-manager-load/use-compiled-handler] when the
|
||||
|
@ -265,7 +267,7 @@ current namespace contains already-loaded versions of modules that may
|
|||
need to be recompiled---unless the already-loaded modules are never
|
||||
referenced by not-yet-loaded modules. References to already-loaded
|
||||
modules may produce compiled files with inconsistent timestamps and/or
|
||||
@filepath{.dep} files with incorrect information.}
|
||||
@filepath{.dep} files with incorrect information.
|
||||
|
||||
The handler logs messages to the topic @racket['compiler/cm] at the level
|
||||
@racket['info]. These messages are instances of a @racket[compile-event] prefab
|
||||
|
@ -282,6 +284,10 @@ which describes the action the event corresponds to. The currently logged values
|
|||
are @racket['locking], @racket['start-compile], @racket['finish-compile], and
|
||||
@racket['already-done].
|
||||
|
||||
@history[#:changed "6.1.1.8" @elem{Added identification of the compilation
|
||||
context via @racket[managed-compiled-context-key].}]}
|
||||
|
||||
|
||||
@defproc[(managed-compile-zo [file path-string?]
|
||||
[read-src-syntax (any/c input-port? . -> . syntax?) read-syntax]
|
||||
[#:security-guard security-guard (or/c security-guard? #f) #f])
|
||||
|
@ -305,7 +311,39 @@ of existing files. If it is @racket[#f], then
|
|||
the security guard in the @racket[current-security-guard] when
|
||||
the files are created is used (not the security guard at the point
|
||||
@racket[managed-compile-zo] is called).
|
||||
}
|
||||
|
||||
While compiling @racket[file], the @racket[error-display-handler]
|
||||
parameter is set to
|
||||
@racket[(make-compilation-context-error-display-handler
|
||||
(error-display-handler))], so that errors from uncaught exceptions
|
||||
will report the compilation context.
|
||||
|
||||
@history[#:changed "6.1.1.8" @elem{Added @racket[error-display-handler]
|
||||
configuration.}]}
|
||||
|
||||
|
||||
@defthing[managed-compiled-context-key any/c]{
|
||||
|
||||
A key used as a continuation mark key by
|
||||
@racket[make-compilation-manager-load/use-compiled-handler] for the
|
||||
continuation of a module compilation. The associated value is a path
|
||||
to the module's source.
|
||||
|
||||
@history[#:added "6.1.1.8"]}
|
||||
|
||||
|
||||
@defproc[(make-compilation-context-error-display-handler
|
||||
[orig-handlers (string? any/c . -> . void?)])
|
||||
(string? any/c . -> . void?)]{
|
||||
|
||||
Produces a handler suitable for use as a
|
||||
@racket[error-display-handler] value, given an existing such value.
|
||||
The generated handler shows information about the compilation context
|
||||
when the handler's second argument is an exception whose continuation
|
||||
marks include @racket[managed-compiled-context-key] keys.
|
||||
|
||||
@history[#:added "6.1.1.8"]}
|
||||
|
||||
|
||||
@defboolparam[trust-existing-zos trust?]{
|
||||
|
||||
|
@ -469,14 +507,27 @@ result will not call @racket[proc] with @racket['unlock].)
|
|||
The @racketmodname[setup/parallel-build] library provides the parallel-compilation
|
||||
functionality of @exec{raco setup} and @exec{raco make}.}
|
||||
|
||||
Both @racket[parallel-compile-files] and @racket[parallel-compile] log messages
|
||||
to the topic @racket['setup/parallel-build] at the level @racket['info]. These
|
||||
messages are instances of a @racket[parallel-compile-event] prefab structure:
|
||||
|
||||
@racketblock[
|
||||
(struct parallel-compile-event (worker event) #:prefab)
|
||||
]
|
||||
|
||||
The worker field is the index of the worker that the created the event. The event
|
||||
field is a @racket[compile-event] as document in
|
||||
@racket[make-compilation-manager-load/use-compiled-handler].
|
||||
|
||||
|
||||
@defproc[(parallel-compile-files [list-of-files (listof path-string?)]
|
||||
[#:worker-count worker-count exact-positive-integer? (processor-count)]
|
||||
[#:handler handler (->i ([worker-id exact-integer?]
|
||||
[handler-type symbol?]
|
||||
[path path-string?]
|
||||
[msg string?]
|
||||
[out string?]
|
||||
[err string?])
|
||||
[#:handler handler (->i ([_worker-id exact-integer?]
|
||||
[_handler-type symbol?]
|
||||
[_path path-string?]
|
||||
[_msg string?]
|
||||
[_out string?]
|
||||
[_err string?])
|
||||
void?)
|
||||
void])
|
||||
(or/c void? #f)]{
|
||||
|
@ -509,40 +560,33 @@ The return value is @racket[(void)] if it was successful, or @racket[#f] if ther
|
|||
|
||||
@defproc[(parallel-compile
|
||||
[worker-count non-negative-integer?]
|
||||
[setup-fprintf (->* ([stage string?] [format string?])
|
||||
[setup-fprintf (->i ([_stage string?] [_format string?])
|
||||
()
|
||||
#:rest (listof any/c) void)]
|
||||
[append-error (-> cc?
|
||||
[prefix string?]
|
||||
[exn (or/c exn? null?)]
|
||||
[out string?]
|
||||
[err srtring?]
|
||||
[message string?]
|
||||
void?)]
|
||||
[append-error (->i ([_cc cc?]
|
||||
[_prefix string?]
|
||||
[_exn (or/c exn? (cons/c string? string?) #f)]
|
||||
[_out string?]
|
||||
[_err srtring?]
|
||||
[_message string?])
|
||||
void?)]
|
||||
[collects-tree (listof any/c)]) (void)]{
|
||||
|
||||
The @racket[parallel-compile] internal utility function is used by @exec{rack
|
||||
setup} to compile collects in parallel. The @racket[worker-count] argument
|
||||
specifies the number of compile workers to spawn during parallel compilation.
|
||||
The @racket[setup-fprintf] and @racket[append-error] functions are internal
|
||||
callback mechanisms that @exec{raco setup} uses to communicate intermediate
|
||||
compilation results. The @racket[collects-tree] argument is a compound
|
||||
datastructure containing an in-memory tree representation of the collects
|
||||
directory.
|
||||
}
|
||||
The @racket[parallel-compile] function is used by @exec{raco setup} to
|
||||
compile collections in parallel. The @racket[worker-count] argument
|
||||
specifies the number of compilation workers to spawn during parallel
|
||||
compilation. The @racket[setup-fprintf] and @racket[append-error]
|
||||
functions communicate intermediate compilation results and errors. The
|
||||
@racket[collects-tree] argument is a compound datastructure containing
|
||||
an in-memory tree representation of the collects directory.
|
||||
|
||||
Both @racket[parallel-compile-files] and @racket[parallel-compile] log messages
|
||||
to the topic @racket['setup/parallel-build] at the level @racket['info]. These
|
||||
messages are instances of a @racket[parallel-compile-event] prefab structure:
|
||||
When the @racket[_exn] argument to @racket[append-error] is a part of
|
||||
strings, the first string is a long form of the error message, and the
|
||||
second string is a short form (omitting evaluation context
|
||||
information, for example).
|
||||
|
||||
|
||||
@racketblock[
|
||||
(struct parallel-compile-event (worker event) #:prefab)
|
||||
]
|
||||
|
||||
The worker field is the index of the worker that the created the event. The event
|
||||
field is a @racket[compile-event] as document in
|
||||
@racket[make-compilation-manager-load/use-compiled-handler].
|
||||
@history[#:changed "6.1.1.8" @elem{Changed @racket[append-error] to allow
|
||||
a pair of error strings.}]}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
|
|
|
@ -26,6 +26,9 @@
|
|||
get-compiled-file-sha1
|
||||
with-compile-output
|
||||
|
||||
managed-compiled-context-key
|
||||
make-compilation-context-error-display-handler
|
||||
|
||||
parallel-lock-client
|
||||
make-compile-lock
|
||||
compile-lock->parallel-lock-client)
|
||||
|
@ -49,6 +52,22 @@
|
|||
(define depth (make-parameter 0))
|
||||
(define parallel-lock-client (make-parameter #f))
|
||||
|
||||
(define managed-compiled-context-key (gensym))
|
||||
(define (make-compilation-context-error-display-handler orig)
|
||||
(lambda (str exn)
|
||||
(define l (continuation-mark-set->list
|
||||
(exn-continuation-marks exn)
|
||||
managed-compiled-context-key))
|
||||
(orig (if (null? l)
|
||||
str
|
||||
(apply
|
||||
string-append
|
||||
str
|
||||
"\n compilation context...:"
|
||||
(for/list ([i (in-list l)])
|
||||
(format "\n ~a" i))))
|
||||
exn)))
|
||||
|
||||
(define (file-stamp-in-collection p)
|
||||
(file-stamp-in-paths p (current-library-collection-paths)))
|
||||
|
||||
|
@ -383,9 +402,12 @@
|
|||
d))
|
||||
rg))]
|
||||
[current-logger accomplice-logger])
|
||||
(get-module-code path mode compile
|
||||
(lambda (a b) #f) ; extension handler
|
||||
#:source-reader read-src-syntax)))
|
||||
(with-continuation-mark
|
||||
managed-compiled-context-key
|
||||
path
|
||||
(get-module-code path mode compile
|
||||
(lambda (a b) #f) ; extension handler
|
||||
#:source-reader read-src-syntax))))
|
||||
(define dest-roots (list (car roots)))
|
||||
(define code-dir (get-compilation-dir path #:modes (list mode) #:roots dest-roots))
|
||||
|
||||
|
@ -689,7 +711,10 @@
|
|||
cache
|
||||
collection-cache
|
||||
#f
|
||||
#:security-guard security-guard)])
|
||||
#:security-guard security-guard)]
|
||||
[error-display-handler
|
||||
(make-compilation-context-error-display-handler
|
||||
(error-display-handler))])
|
||||
(compile-root (car (use-compiled-file-paths))
|
||||
(current-compiled-file-roots)
|
||||
(path->complete-path src)
|
||||
|
|
|
@ -13,6 +13,7 @@
|
|||
compiler/find-exe
|
||||
racket/place
|
||||
syntax/modresolve
|
||||
"private/format-error.rkt"
|
||||
(for-syntax racket/base))
|
||||
|
||||
|
||||
|
@ -90,8 +91,8 @@
|
|||
[(list (list cc file last) (list result-type out err))
|
||||
(begin0
|
||||
(match result-type
|
||||
[(list 'ERROR msg)
|
||||
(append-error cc "making" (exn msg (current-continuation-marks)) out err "error")
|
||||
[(list 'ERROR long-msg short-msg)
|
||||
(append-error cc "making" (cons long-msg short-msg) out err "error")
|
||||
#t]
|
||||
[(list 'LOCK fn) (lm/lock lock-mgr fn wrkr) #f]
|
||||
[(list 'UNLOCK fn) (lm/unlock lock-mgr fn) #f]
|
||||
|
@ -102,7 +103,7 @@
|
|||
['DONE
|
||||
(define (string-!empty? s) (not (zero? (string-length s))))
|
||||
(when (ormap string-!empty? (list out err))
|
||||
(append-error cc "making" null out err "output"))
|
||||
(append-error cc "making" #f out err "output"))
|
||||
;(when last (printer (current-output-port) "made" "~a" (cc-name cc)))
|
||||
#t]
|
||||
[else (eprintf "Failed trying to match:\n~e\n" result-type)]))]
|
||||
|
@ -112,7 +113,7 @@
|
|||
[else
|
||||
(match work
|
||||
[(list-rest (list cc file last) message)
|
||||
(append-error cc "making" null "" "" "error")
|
||||
(append-error cc "making" #f "" "" "error")
|
||||
(eprintf "work-done match cc failed.\n")
|
||||
(eprintf "trying to match:\n~e\n" (list work msg))
|
||||
#t]
|
||||
|
@ -301,11 +302,12 @@
|
|||
(send/msg (list (list 'UNLOCK (path->bytes fn)) "" ""))]
|
||||
[x (send/error (format "DIDNT MATCH C ~v\n" x))]
|
||||
[else (send/error (format "DIDNT MATCH C\n"))]))
|
||||
(with-handlers ([exn:fail? (lambda (x)
|
||||
(define sp (open-output-string))
|
||||
(parameterize ([current-error-port sp])
|
||||
((error-display-handler) (exn-message x) x))
|
||||
(send/resp (list 'ERROR (get-output-string sp))))])
|
||||
(with-handlers ([exn:fail? (lambda (x)
|
||||
(send/resp (list 'ERROR
|
||||
;; Long form shows context:
|
||||
(format-error x #:long? #t #:to-string? #t)
|
||||
;; Short form for summary omits context:
|
||||
(format-error x #:long? #f #:to-string? #t))))])
|
||||
(parameterize ([parallel-lock-client lock-client]
|
||||
[compile-context-preservation-enabled (member 'disable-inlining options )]
|
||||
[manager-trace-handler
|
||||
|
|
32
racket/collects/setup/private/format-error.rkt
Normal file
32
racket/collects/setup/private/format-error.rkt
Normal file
|
@ -0,0 +1,32 @@
|
|||
#lang racket/base
|
||||
(require compiler/cm
|
||||
setup/path-to-relative)
|
||||
|
||||
(provide format-error)
|
||||
|
||||
(define (format-error exn
|
||||
#:long? [long? #t]
|
||||
#:to-string? [to-string? #f]
|
||||
#:cache [pkg-path-cache #f])
|
||||
(let loop ([to-string? to-string?])
|
||||
(cond
|
||||
[to-string?
|
||||
(define sp (open-output-string))
|
||||
(parameterize ([current-error-port sp])
|
||||
(loop #f))
|
||||
(regexp-replace #rx"\n$" (get-output-string sp) "")]
|
||||
[long?
|
||||
((make-compilation-context-error-display-handler
|
||||
(lambda (str exn)
|
||||
((error-display-handler)
|
||||
str
|
||||
exn)))
|
||||
(exn-message exn)
|
||||
exn)]
|
||||
[else
|
||||
(eprintf "~a\n" (exn-message exn))
|
||||
(define path (continuation-mark-set-first (exn-continuation-marks exn)
|
||||
managed-compiled-context-key))
|
||||
(when (path-string? path)
|
||||
(eprintf " compiling: ~a"
|
||||
(path->relative-string/setup path #:cache pkg-path-cache)))])))
|
|
@ -37,6 +37,7 @@
|
|||
"private/elf.rkt"
|
||||
"private/pkg-deps.rkt"
|
||||
"collection-name.rkt"
|
||||
"private/format-error.rkt"
|
||||
compiler/private/dep
|
||||
(only-in pkg/lib pkg-directory
|
||||
pkg-single-collection))
|
||||
|
@ -151,12 +152,13 @@
|
|||
(when (fail-fast)
|
||||
(break-thread original-thread)))
|
||||
(define (handle-error cc desc exn out err type)
|
||||
(if (verbose)
|
||||
((error-display-handler)
|
||||
(format "~a\n" (exn->string exn))
|
||||
exn)
|
||||
(eprintf "~a\n" (exn->string exn)))
|
||||
(append-error cc desc exn out err type))
|
||||
(define long? #t) ; possibly better: (define long? (verbose))
|
||||
(cond
|
||||
[(exn? exn)
|
||||
(format-error exn #:long? long?)]
|
||||
[(and (pair? exn) (string? (car exn)) (string? (cdr exn)))
|
||||
(eprintf "~a\n" ((if long? car cdr) exn))])
|
||||
(append-error cc desc exn out err type))
|
||||
(define (record-error cc desc go fail-k)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (x)
|
||||
|
@ -174,8 +176,12 @@
|
|||
[(path? cc)
|
||||
(path->relative-string/setup cc #:cache pkg-path-cache)]
|
||||
[else cc]))
|
||||
(unless (null? x) (for ([str (in-list (regexp-split #rx"\n" (exn->string x)))])
|
||||
(setup-fprintf port #f " ~a" str)))
|
||||
(let ([msg (if (exn? x)
|
||||
(format-error x #:long? #f #:to-string? #t #:cache pkg-path-cache)
|
||||
;; `x` is a pair of long and short strings:
|
||||
(cdr x))])
|
||||
(unless (null? x) (for ([str (in-list (regexp-split #rx"\n" msg))])
|
||||
(setup-fprintf port #f " ~a" str))))
|
||||
(unless (zero? (string-length out)) (eprintf "STDOUT:\n~a=====\n" out))
|
||||
(unless (zero? (string-length err)) (eprintf "STDERR:\n~a=====\n" err)))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user