build-system/guile: Improve reporting of 'guild compile' failures.

* guix/build/guile-build-system.scm (invoke-each)[processes]: New
variable.
[wait-for-one-process]: Check PROCESSES and update it.
[fork-and-run-command]: Update PROCESSES.
This commit is contained in:
Ludovic Courtès 2019-06-02 20:57:59 +02:00
parent bdf2dd797e
commit abeb54c00b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 4 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -74,11 +74,19 @@ Raise an error if one of the processes exit with non-zero."
(define total (define total
(length commands)) (length commands))
(define processes
(make-hash-table))
(define (wait-for-one-process) (define (wait-for-one-process)
(match (waitpid WAIT_ANY) (match (waitpid WAIT_ANY)
((_ . status) ((pid . status)
(unless (zero? (status:exit-val status)) (let ((command (hashv-ref processes pid)))
(error "process failed" status))))) (hashv-remove! processes command)
(unless (zero? (status:exit-val status))
(format (current-error-port)
"process '~{~a ~}' failed with status ~a~%"
command status)
(exit 1))))))
(define (fork-and-run-command command) (define (fork-and-run-command command)
(match (primitive-fork) (match (primitive-fork)
@ -90,6 +98,7 @@ Raise an error if one of the processes exit with non-zero."
(lambda () (lambda ()
(primitive-exit 127)))) (primitive-exit 127))))
(pid (pid
(hashv-set! processes pid command)
#t))) #t)))
(let loop ((commands commands) (let loop ((commands commands)