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]
[else (filter main-doc? docs)])) ; Don't need them, so drop them
(define (parallel-do-error-handler setup-printf doc errmsg outstr errstr)
(setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
(eprintf "~a" errmsg)
(eprintf "~a" errstr))
(define (parallel-do-error-handler with-record-error doc errmsg outstr errstr)
(with-record-error
(doc-src-file doc)
(lambda () (error errmsg))
void))
;; We use a lock to control writing to the database. It's not
;; strictly necessary, but place channels can deal with blocking
@ -351,7 +352,7 @@
(printf "~a" errstr)
(deserialize (fasl->s-exp r)))
(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
auto-main? auto-user? main-doc-exists?
force-out-of-date? lock-ch)
@ -681,7 +682,7 @@
(printf "~a" errstr)
(update-info! i (deserialize (fasl->s-exp r))))
(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
main-doc-exists?)
(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)
(for ([e (reverse errors)])
(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)))])
(setup-fprintf port #f " ~a" str)))
(unless (zero? (string-length out)) (eprintf "STDOUT:\n~a=====\n" out))
@ -674,7 +678,7 @@
(assume-virtual-sources? cc)))))
(define (clean-collection cc dependencies)
(begin-record-error cc "Cleaning"
(begin-record-error cc "cleaning"
(define info (cc-info cc))
(define paths
(call-info
@ -775,9 +779,9 @@
(for ([cc ccs-to-compile])
(let/ec k
(begin-record-error cc (case part
[(pre) "Early Install"]
[(general) "General Install"]
[(post) "Post Install"])
[(pre) "early install"]
[(general) "general install"]
[(post) "post install"])
(define fn
(call-info (cc-info cc)
(case part
@ -1235,7 +1239,7 @@
(if no-specific-collections? #f (map cc-path ccs-to-compile))
latex-dest auto-start-doc? (make-user)
(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))
(define (make-docs-step)
@ -1293,7 +1297,7 @@
(define ((or-f f) x) (when x (f x)))
(define created-launchers (make-hash))
(for ([cc ccs-to-compile])
(begin-record-error cc "Launcher Setup"
(begin-record-error cc "launcher setup"
(define info (cc-info cc))
(define (make-launcher kind
launcher-names
@ -1704,7 +1708,7 @@
(define make-foreign-libs-step
(make-copy/move-step "foreign library"
"foreign libraries"
"Foreign Library Setup"
"foreign library setup"
'copy-foreign-libs
'move-foreign-libs
find-lib-dir
@ -1720,7 +1724,7 @@
(define make-shares-step
(make-copy/move-step "shared file"
"shared files"
"Share Files Setup"
"share files setup"
'copy-shared-files
'move-shared-files
find-share-dir
@ -1736,7 +1740,7 @@
(define make-mans-step
(make-copy/move-step "man page"
"man pages"
"Man Page Setup"
"man page setup"
'copy-man-pages
'move-man-pages
find-man-dir