diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-02 20:57:59 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-02 22:01:34 +0200 |
commit | abeb54c00b320f8c3a220f54b6413837f6deac35 (patch) | |
tree | 499af35cdd3a5abdf81fd5564698c5bc059e0d4c /guix/build | |
parent | bdf2dd797e1e57dab1d504a6e1af783ec5802afd (diff) | |
download | gnu-guix-abeb54c00b320f8c3a220f54b6413837f6deac35.tar gnu-guix-abeb54c00b320f8c3a220f54b6413837f6deac35.tar.gz |
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.
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/guile-build-system.scm | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm index 31f0d3d6f4..69819c87f1 100644 --- a/guix/build/guile-build-system.scm +++ b/guix/build/guile-build-system.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -74,11 +74,19 @@ Raise an error if one of the processes exit with non-zero." (define total (length commands)) + (define processes + (make-hash-table)) + (define (wait-for-one-process) (match (waitpid WAIT_ANY) - ((_ . status) - (unless (zero? (status:exit-val status)) - (error "process failed" status))))) + ((pid . status) + (let ((command (hashv-ref processes pid))) + (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) (match (primitive-fork) @@ -90,6 +98,7 @@ Raise an error if one of the processes exit with non-zero." (lambda () (primitive-exit 127)))) (pid + (hashv-set! processes pid command) #t))) (let loop ((commands commands) |