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:
Matthew Flatt 2015-02-15 09:46:47 -07:00
parent 1c4c76dd57
commit 17275b946a
5 changed files with 166 additions and 57 deletions

View File

@ -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 the files are created is used (not the security guard at the point
@racket[make-compilation-manager-load/use-compiled-handler] is called). @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 @emph{Do not} install the result of
@racket[make-compilation-manager-load/use-compiled-handler] when the @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 need to be recompiled---unless the already-loaded modules are never
referenced by not-yet-loaded modules. References to already-loaded referenced by not-yet-loaded modules. References to already-loaded
modules may produce compiled files with inconsistent timestamps and/or 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 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 @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 are @racket['locking], @racket['start-compile], @racket['finish-compile], and
@racket['already-done]. @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?] @defproc[(managed-compile-zo [file path-string?]
[read-src-syntax (any/c input-port? . -> . syntax?) read-syntax] [read-src-syntax (any/c input-port? . -> . syntax?) read-syntax]
[#:security-guard security-guard (or/c security-guard? #f) #f]) [#: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 security guard in the @racket[current-security-guard] when
the files are created is used (not the security guard at the point the files are created is used (not the security guard at the point
@racket[managed-compile-zo] is called). @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?]{ @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 The @racketmodname[setup/parallel-build] library provides the parallel-compilation
functionality of @exec{raco setup} and @exec{raco make}.} 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?)] @defproc[(parallel-compile-files [list-of-files (listof path-string?)]
[#:worker-count worker-count exact-positive-integer? (processor-count)] [#:worker-count worker-count exact-positive-integer? (processor-count)]
[#:handler handler (->i ([worker-id exact-integer?] [#:handler handler (->i ([_worker-id exact-integer?]
[handler-type symbol?] [_handler-type symbol?]
[path path-string?] [_path path-string?]
[msg string?] [_msg string?]
[out string?] [_out string?]
[err string?]) [_err string?])
void?) void?)
void]) void])
(or/c void? #f)]{ (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 @defproc[(parallel-compile
[worker-count non-negative-integer?] [worker-count non-negative-integer?]
[setup-fprintf (->* ([stage string?] [format string?]) [setup-fprintf (->i ([_stage string?] [_format string?])
() ()
#:rest (listof any/c) void)] #:rest (listof any/c) void)]
[append-error (-> cc? [append-error (->i ([_cc cc?]
[prefix string?] [_prefix string?]
[exn (or/c exn? null?)] [_exn (or/c exn? (cons/c string? string?) #f)]
[out string?] [_out string?]
[err srtring?] [_err srtring?]
[message string?] [_message string?])
void?)] void?)]
[collects-tree (listof any/c)]) (void)]{ [collects-tree (listof any/c)]) (void)]{
The @racket[parallel-compile] internal utility function is used by @exec{rack The @racket[parallel-compile] function is used by @exec{raco setup} to
setup} to compile collects in parallel. The @racket[worker-count] argument compile collections in parallel. The @racket[worker-count] argument
specifies the number of compile workers to spawn during parallel compilation. specifies the number of compilation workers to spawn during parallel
The @racket[setup-fprintf] and @racket[append-error] functions are internal compilation. The @racket[setup-fprintf] and @racket[append-error]
callback mechanisms that @exec{raco setup} uses to communicate intermediate functions communicate intermediate compilation results and errors. The
compilation results. The @racket[collects-tree] argument is a compound @racket[collects-tree] argument is a compound datastructure containing
datastructure containing an in-memory tree representation of the collects an in-memory tree representation of the collects directory.
directory.
}
Both @racket[parallel-compile-files] and @racket[parallel-compile] log messages When the @racket[_exn] argument to @racket[append-error] is a part of
to the topic @racket['setup/parallel-build] at the level @racket['info]. These strings, the first string is a long form of the error message, and the
messages are instances of a @racket[parallel-compile-event] prefab structure: second string is a short form (omitting evaluation context
information, for example).
@history[#:changed "6.1.1.8" @elem{Changed @racket[append-error] to allow
@racketblock[ a pair of error strings.}]}
(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].
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------

View File

@ -26,6 +26,9 @@
get-compiled-file-sha1 get-compiled-file-sha1
with-compile-output with-compile-output
managed-compiled-context-key
make-compilation-context-error-display-handler
parallel-lock-client parallel-lock-client
make-compile-lock make-compile-lock
compile-lock->parallel-lock-client) compile-lock->parallel-lock-client)
@ -49,6 +52,22 @@
(define depth (make-parameter 0)) (define depth (make-parameter 0))
(define parallel-lock-client (make-parameter #f)) (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) (define (file-stamp-in-collection p)
(file-stamp-in-paths p (current-library-collection-paths))) (file-stamp-in-paths p (current-library-collection-paths)))
@ -383,9 +402,12 @@
d)) d))
rg))] rg))]
[current-logger accomplice-logger]) [current-logger accomplice-logger])
(with-continuation-mark
managed-compiled-context-key
path
(get-module-code path mode compile (get-module-code path mode compile
(lambda (a b) #f) ; extension handler (lambda (a b) #f) ; extension handler
#:source-reader read-src-syntax))) #:source-reader read-src-syntax))))
(define dest-roots (list (car roots))) (define dest-roots (list (car roots)))
(define code-dir (get-compilation-dir path #:modes (list mode) #:roots dest-roots)) (define code-dir (get-compilation-dir path #:modes (list mode) #:roots dest-roots))
@ -689,7 +711,10 @@
cache cache
collection-cache collection-cache
#f #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)) (compile-root (car (use-compiled-file-paths))
(current-compiled-file-roots) (current-compiled-file-roots)
(path->complete-path src) (path->complete-path src)

View File

@ -13,6 +13,7 @@
compiler/find-exe compiler/find-exe
racket/place racket/place
syntax/modresolve syntax/modresolve
"private/format-error.rkt"
(for-syntax racket/base)) (for-syntax racket/base))
@ -90,8 +91,8 @@
[(list (list cc file last) (list result-type out err)) [(list (list cc file last) (list result-type out err))
(begin0 (begin0
(match result-type (match result-type
[(list 'ERROR msg) [(list 'ERROR long-msg short-msg)
(append-error cc "making" (exn msg (current-continuation-marks)) out err "error") (append-error cc "making" (cons long-msg short-msg) out err "error")
#t] #t]
[(list 'LOCK fn) (lm/lock lock-mgr fn wrkr) #f] [(list 'LOCK fn) (lm/lock lock-mgr fn wrkr) #f]
[(list 'UNLOCK fn) (lm/unlock lock-mgr fn) #f] [(list 'UNLOCK fn) (lm/unlock lock-mgr fn) #f]
@ -102,7 +103,7 @@
['DONE ['DONE
(define (string-!empty? s) (not (zero? (string-length s)))) (define (string-!empty? s) (not (zero? (string-length s))))
(when (ormap string-!empty? (list out err)) (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))) ;(when last (printer (current-output-port) "made" "~a" (cc-name cc)))
#t] #t]
[else (eprintf "Failed trying to match:\n~e\n" result-type)]))] [else (eprintf "Failed trying to match:\n~e\n" result-type)]))]
@ -112,7 +113,7 @@
[else [else
(match work (match work
[(list-rest (list cc file last) message) [(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 "work-done match cc failed.\n")
(eprintf "trying to match:\n~e\n" (list work msg)) (eprintf "trying to match:\n~e\n" (list work msg))
#t] #t]
@ -302,10 +303,11 @@
[x (send/error (format "DIDNT MATCH C ~v\n" x))] [x (send/error (format "DIDNT MATCH C ~v\n" x))]
[else (send/error (format "DIDNT MATCH C\n"))])) [else (send/error (format "DIDNT MATCH C\n"))]))
(with-handlers ([exn:fail? (lambda (x) (with-handlers ([exn:fail? (lambda (x)
(define sp (open-output-string)) (send/resp (list 'ERROR
(parameterize ([current-error-port sp]) ;; Long form shows context:
((error-display-handler) (exn-message x) x)) (format-error x #:long? #t #:to-string? #t)
(send/resp (list 'ERROR (get-output-string sp))))]) ;; Short form for summary omits context:
(format-error x #:long? #f #:to-string? #t))))])
(parameterize ([parallel-lock-client lock-client] (parameterize ([parallel-lock-client lock-client]
[compile-context-preservation-enabled (member 'disable-inlining options )] [compile-context-preservation-enabled (member 'disable-inlining options )]
[manager-trace-handler [manager-trace-handler

View 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)))])))

View File

@ -37,6 +37,7 @@
"private/elf.rkt" "private/elf.rkt"
"private/pkg-deps.rkt" "private/pkg-deps.rkt"
"collection-name.rkt" "collection-name.rkt"
"private/format-error.rkt"
compiler/private/dep compiler/private/dep
(only-in pkg/lib pkg-directory (only-in pkg/lib pkg-directory
pkg-single-collection)) pkg-single-collection))
@ -151,11 +152,12 @@
(when (fail-fast) (when (fail-fast)
(break-thread original-thread))) (break-thread original-thread)))
(define (handle-error cc desc exn out err type) (define (handle-error cc desc exn out err type)
(if (verbose) (define long? #t) ; possibly better: (define long? (verbose))
((error-display-handler) (cond
(format "~a\n" (exn->string exn)) [(exn? exn)
exn) (format-error exn #:long? long?)]
(eprintf "~a\n" (exn->string exn))) [(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)) (append-error cc desc exn out err type))
(define (record-error cc desc go fail-k) (define (record-error cc desc go fail-k)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
@ -174,8 +176,12 @@
[(path? cc) [(path? cc)
(path->relative-string/setup cc #:cache pkg-path-cache)] (path->relative-string/setup cc #:cache pkg-path-cache)]
[else cc])) [else cc]))
(unless (null? x) (for ([str (in-list (regexp-split #rx"\n" (exn->string x)))]) (let ([msg (if (exn? x)
(setup-fprintf port #f " ~a" str))) (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 out)) (eprintf "STDOUT:\n~a=====\n" out))
(unless (zero? (string-length err)) (eprintf "STDERR:\n~a=====\n" err))))) (unless (zero? (string-length err)) (eprintf "STDERR:\n~a=====\n" err)))))