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