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
@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.}]}
@; ----------------------------------------------------------------------

View File

@ -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)

View File

@ -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

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/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)))))