suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: propagate doc-build error in summary and exit status

Browse Source
This commit is contained in:
Matthew Flatt 2014-07-04 10:42:22 +01:00
parent 4ae38d3f0f
commit b64db3d0e6
2 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -102,10 +102,11 @@
docs] docs]
[else (filter main-doc? docs)])) ; Don't need them, so drop them [else (filter main-doc? docs)])) ; Don't need them, so drop them
(define (parallel-do-error-handler setup-printf doc errmsg outstr errstr) (define (parallel-do-error-handler with-record-error doc errmsg outstr errstr)
(setup-printf "error running" (module-path-prefix->string (doc-src-spec doc))) (with-record-error
(eprintf "~a" errmsg) (doc-src-file doc)
(eprintf "~a" errstr)) (lambda () (error errmsg))
void))
;; We use a lock to control writing to the database. It's not ;; We use a lock to control writing to the database. It's not
;; strictly necessary, but place channels can deal with blocking ;; strictly necessary, but place channels can deal with blocking
@ -351,7 +352,7 @@
(printf "~a" errstr) (printf "~a" errstr)
(deserialize (fasl->s-exp r))) (deserialize (fasl->s-exp r)))
(lambda (work errmsg outstr errstr) (lambda (work errmsg outstr errstr)
(parallel-do-error-handler setup-printf work errmsg outstr errstr))) (parallel-do-error-handler with-record-error work errmsg outstr errstr)))
(define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest
auto-main? auto-user? main-doc-exists? auto-main? auto-user? main-doc-exists?
force-out-of-date? lock-ch) force-out-of-date? lock-ch)
@ -681,7 +682,7 @@
(printf "~a" errstr) (printf "~a" errstr)
(update-info! i (deserialize (fasl->s-exp r)))) (update-info! i (deserialize (fasl->s-exp r))))
(lambda (i errmsg outstr errstr) (lambda (i errmsg outstr errstr)
(parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr))) (parallel-do-error-handler with-record-error (info-doc i) errmsg outstr errstr)))
(define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch (define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch
main-doc-exists?) main-doc-exists?)
(define (with-record-error cc go fail-k) (define (with-record-error cc go fail-k)

24
racket/collects/setup/setup-core.rkt
View File

@ -162,7 +162,11 @@
(define (show-errors port) (define (show-errors port)
(for ([e (reverse errors)]) (for ([e (reverse errors)])
(match-let ([(list cc desc x out err type) e]) (match-let ([(list cc desc x out err type) e])
(setup-fprintf port type "during ~a for ~a" desc (if (cc? cc) (cc-name cc) cc)) (setup-fprintf port type "during ~a for ~a" desc (cond
[(cc? cc) (cc-name cc)]
[(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)))]) (unless (null? x) (for ([str (in-list (regexp-split #rx"\n" (exn->string x)))])
(setup-fprintf port #f " ~a" str))) (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))
@ -674,7 +678,7 @@
(assume-virtual-sources? cc))))) (assume-virtual-sources? cc)))))
(define (clean-collection cc dependencies) (define (clean-collection cc dependencies)
(begin-record-error cc "Cleaning" (begin-record-error cc "cleaning"
(define info (cc-info cc)) (define info (cc-info cc))
(define paths (define paths
(call-info (call-info
@ -775,9 +779,9 @@
(for ([cc ccs-to-compile]) (for ([cc ccs-to-compile])
(let/ec k (let/ec k
(begin-record-error cc (case part (begin-record-error cc (case part
[(pre) "Early Install"] [(pre) "early install"]
[(general) "General Install"] [(general) "general install"]
[(post) "Post Install"]) [(post) "post install"])
(define fn (define fn
(call-info (cc-info cc) (call-info (cc-info cc)
(case part (case part
@ -1235,7 +1239,7 @@
(if no-specific-collections? #f (map cc-path ccs-to-compile)) (if no-specific-collections? #f (map cc-path ccs-to-compile))
latex-dest auto-start-doc? (make-user) latex-dest auto-start-doc? (make-user)
(make-tidy) (avoid-main-installation) (make-tidy) (avoid-main-installation)
(lambda (what go alt) (record-error what "Building docs" go alt)) (lambda (what go alt) (record-error what "building docs" go alt))
setup-printf)) setup-printf))
(define (make-docs-step) (define (make-docs-step)
@ -1293,7 +1297,7 @@
(define ((or-f f) x) (when x (f x))) (define ((or-f f) x) (when x (f x)))
(define created-launchers (make-hash)) (define created-launchers (make-hash))
(for ([cc ccs-to-compile]) (for ([cc ccs-to-compile])
(begin-record-error cc "Launcher Setup" (begin-record-error cc "launcher setup"
(define info (cc-info cc)) (define info (cc-info cc))
(define (make-launcher kind (define (make-launcher kind
launcher-names launcher-names
@ -1704,7 +1708,7 @@
(define make-foreign-libs-step (define make-foreign-libs-step
(make-copy/move-step "foreign library" (make-copy/move-step "foreign library"
"foreign libraries" "foreign libraries"
"Foreign Library Setup" "foreign library setup"
'copy-foreign-libs 'copy-foreign-libs
'move-foreign-libs 'move-foreign-libs
find-lib-dir find-lib-dir
@ -1720,7 +1724,7 @@
(define make-shares-step (define make-shares-step
(make-copy/move-step "shared file" (make-copy/move-step "shared file"
"shared files" "shared files"
"Share Files Setup" "share files setup"
'copy-shared-files 'copy-shared-files
'move-shared-files 'move-shared-files
find-share-dir find-share-dir
@ -1736,7 +1740,7 @@
(define make-mans-step (define make-mans-step
(make-copy/move-step "man page" (make-copy/move-step "man page"
"man pages" "man pages"
"Man Page Setup" "man page setup"
'copy-man-pages 'copy-man-pages
'move-man-pages 'move-man-pages
find-man-dir find-man-dir