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

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

@ -370,24 +370,25 @@
(* 30 60))) (* 30 60)))
(define orig-thread (current-thread)) (define orig-thread (current-thread))
(define timeout? #f) (define timeout? #f)
(parameterize ([current-custodian cust]) (begin0
(thread (lambda () (parameterize ([current-custodian cust])
(sleep (* timeout-factor timeout)) (thread (lambda ()
(eprintf "timeout for ~s\n" (client-name c)) (sleep (* timeout-factor timeout))
;; try nice interrupt, first: (eprintf "timeout for ~s\n" (client-name c))
(set! timeout? #t) ;; try nice interrupt, first:
(break-thread orig-thread) (set! timeout? #t)
(sleep 1) (break-thread orig-thread)
;; force quit: (sleep 1)
(custodian-shutdown-all cust))) ;; force quit:
(with-handlers ([exn? (lambda (exn) (custodian-shutdown-all cust)))
(when (exn:break? exn) (with-handlers ([exn? (lambda (exn)
(unless timeout? (when (exn:break? exn)
(set! stop? #t))) (unless timeout?
(log-error "~a failed..." (client-name c)) (set! stop? #t)))
(log-error (exn-message exn)))]) (log-error "~a failed..." (client-name c))
(thunk))) (log-error (exn-message exn)))])
(custodian-shutdown-all cust))) (thunk)))
(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:
(limit-and-report-failure (begin0
c 1 (limit-and-report-failure
(lambda () (client-build c))) c 1
;; stop client, if a VM: (lambda () (client-build c)))
(stop-client c)))))])))) ;; stop client, if a VM:
(stop-client c))))))]))))
(display-time) (display-time)