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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit abeb54c00b320f8c3a220f54b6413837f6deac35
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jun 2 20:57:59 2019 +0200

    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.
---
 guix/build/guile-build-system.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/guix/build/guile-build-system.scm 
b/guix/build/guile-build-system.scm
index 31f0d3d..69819c8 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 <address@hidden>
+;;; Copyright © 2018, 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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)