From 17275b946aa2fe7078616dfab1235526e06373e4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 15 Feb 2015 09:46:47 -0700 Subject: [PATCH] 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. --- pkgs/racket-doc/scribblings/raco/make.scrbl | 116 ++++++++++++------ racket/collects/compiler/cm.rkt | 33 ++++- racket/collects/setup/parallel-build.rkt | 20 +-- .../collects/setup/private/format-error.rkt | 32 +++++ racket/collects/setup/setup-core.rkt | 22 ++-- 5 files changed, 166 insertions(+), 57 deletions(-) create mode 100644 racket/collects/setup/private/format-error.rkt diff --git a/pkgs/racket-doc/scribblings/raco/make.scrbl b/pkgs/racket-doc/scribblings/raco/make.scrbl index b98b4dc483..4407484024 100644 --- a/pkgs/racket-doc/scribblings/raco/make.scrbl +++ b/pkgs/racket-doc/scribblings/raco/make.scrbl @@ -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.}]} @; ---------------------------------------------------------------------- diff --git a/racket/collects/compiler/cm.rkt b/racket/collects/compiler/cm.rkt index de97ea30ea..b92adca448 100644 --- a/racket/collects/compiler/cm.rkt +++ b/racket/collects/compiler/cm.rkt @@ -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) diff --git a/racket/collects/setup/parallel-build.rkt b/racket/collects/setup/parallel-build.rkt index ff50ea8fd6..1a655942bf 100644 --- a/racket/collects/setup/parallel-build.rkt +++ b/racket/collects/setup/parallel-build.rkt @@ -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 diff --git a/racket/collects/setup/private/format-error.rkt b/racket/collects/setup/private/format-error.rkt new file mode 100644 index 0000000000..04e05500b5 --- /dev/null +++ b/racket/collects/setup/private/format-error.rkt @@ -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)))]))) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 1ffacad3f0..16581acf89 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -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)))))