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

distro-build: improve failure reporting

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-25 08:57:39 -06:00
parent 265603ed69
commit 949ea16cbf
1 changed files with 30 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/distro-build/drive-clients.rkt
View File

@ -370,6 +370,7 @@
(* 30 60)))
(define orig-thread (current-thread))
(define timeout? #f)
(begin0
(parameterize ([current-custodian cust])
(thread (lambda ()
(sleep (* timeout-factor timeout))
@ -387,7 +388,7 @@
(log-error "~a failed..." (client-name c))
(log-error (exn-message exn)))])
(thunk)))
(custodian-shutdown-all cust)))
(custodian-shutdown-all cust))))
(define (client-thread c sequential? thunk)
(unless stop?
@ -400,9 +401,10 @@
(define p (open-output-file log-file
#:exists 'truncate/replace))
(file-stream-buffer-mode p 'line)
(parameterize ([current-output-port p]
(unless (parameterize ([current-output-port p]
[current-error-port p])
(thunk)))
(thunk))
(printf "Build FAILED for ~s\n" (client-name c))))
(cond
[sequential? (go) (thread void)]
[else (thread go)])))
@ -443,10 +445,11 @@
(start-client c (or (get-opt c '#:max-vm) 1))
;; catch failure in build step proper, so we
;; can more likely stop the client:
(begin0
(limit-and-report-failure
c 1
(lambda () (client-build c)))
;; stop client, if a VM:
(stop-client c)))))]))))
(stop-client c))))))]))))
(display-time)