04/05: utils: Add 'invoke/quiet'.

[guix-commits]

civodul pushed a commit to branch core-updates
in repository guix.

commit 45d46223f92b0933aaf9b1392a21d09eaa1e2881
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jun 17 16:06:27 2019 +0200

    utils: Add 'invoke/quiet'.
    
    * gnu/build/bootloader.scm (G_): Remove.
    (open-pipe-with-stderr, invoke/quiet): Move to...
    * guix/build/utils.scm: ... here.  Use 'let-values' instead of
    'define-values' because Guile 2.0 (the bootstrap Guile) doesn't know
    about 'define-values'.
    * po/guix/POTFILES.in: Remove gnu/build/bootloader.scm, and add
    guix/build/utils.scm.
    * tests/build-utils.scm: Remove import of (gnu build bootloader).
---
 gnu/build/bootloader.scm | 62 +-----------------------------------------------
 guix/build/utils.scm     | 53 +++++++++++++++++++++++++++++++++++++++++
 po/guix/POTFILES.in      |  3 +--
 tests/build-utils.scm    |  2 --
 4 files changed, 55 insertions(+), 65 deletions(-)

diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index c5febcd..9570d6d 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -18,15 +18,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu build bootloader)
-  #:use-module (srfi srfi-34)
-  #:use-module (srfi srfi-35)
   #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 popen)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 format)
-  #:export (write-file-on-device
-            invoke/quiet))
+  #:export (write-file-on-device))
 
 
 ;;;
@@ -43,56 +36,3 @@
             (seek output offset SEEK_SET)
             (put-bytevector output bv))
           #:binary #t)))))
-
-(define-syntax-rule (G_ str) str)                 ;for xgettext
-
-(define (open-pipe-with-stderr program . args)
-  "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect
-both its standard output and standard error to the pipe.  Return two value:
-the pipe to read PROGRAM's data from, and the PID of the child process running
-PROGRAM."
-  ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why
-  ;; we need to roll our own.
-  (match (pipe)
-    ((input .  output)
-     (match (primitive-fork)
-       (0
-        (dynamic-wind
-          (const #t)
-          (lambda ()
-            (close-port input)
-            (dup2 (fileno output) 1)
-            (dup2 (fileno output) 2)
-            (apply execlp program program args))
-          (lambda ()
-            (primitive-exit 127))))
-       (pid
-        (close-port output)
-        (values input pid))))))
-
-;; TODO: Move to (guix build utils) on the next rebuild cycle.
-(define (invoke/quiet program . args)
-  "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard
-error.  If PROGRAM succeeds, print nothing and return the unspecified value;
-otherwise, raise a '&message' error condition that includes the status code
-and the output of PROGRAM."
-  (define-values (pipe pid)
-    (apply open-pipe-with-stderr program args))
-
-  (let loop ((lines '()))
-    (match (read-line pipe)
-      ((? eof-object?)
-       (close-port pipe)
-       (match (waitpid pid)
-         ((_ . status)
-          (unless (zero? status)
-            (raise (condition
-                    (&message
-                     (message (format #f (G_ "'~a~{ ~a~}' exited with status 
~a; \
-output follows:~%~%~{  ~a~%~}")
-                                      program args
-                                      (or (status:exit-val status)
-                                          status)
-                                      (reverse lines))))))))))
-      (line
-       (loop (cons line lines))))))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index b7cd748..b8be73e 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -106,6 +106,8 @@
             invoke-error-stop-signal
             report-invoke-error
 
+            invoke/quiet
+
             locale-category->string))
 
 
@@ -666,6 +668,57 @@ way."
               (invoke-error-term-signal c)
               (invoke-error-stop-signal c))))
 
+(define (open-pipe-with-stderr program . args)
+  "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect
+both its standard output and standard error to the pipe.  Return two value:
+the pipe to read PROGRAM's data from, and the PID of the child process running
+PROGRAM."
+  ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why
+  ;; we need to roll our own.
+  (match (pipe)
+    ((input .  output)
+     (match (primitive-fork)
+       (0
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close-port input)
+            (dup2 (fileno output) 1)
+            (dup2 (fileno output) 2)
+            (apply execlp program program args))
+          (lambda ()
+            (primitive-exit 127))))
+       (pid
+        (close-port output)
+        (values input pid))))))
+
+(define (invoke/quiet program . args)
+  "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard
+error.  If PROGRAM succeeds, print nothing and return the unspecified value;
+otherwise, raise a '&message' error condition that includes the status code
+and the output of PROGRAM."
+  (let-values (((pipe pid)
+                (apply open-pipe-with-stderr program args)))
+    (let loop ((lines '()))
+      (match (read-line pipe)
+        ((? eof-object?)
+         (close-port pipe)
+         (match (waitpid pid)
+           ((_ . status)
+            (unless (zero? status)
+              (let-syntax ((G_ (syntax-rules ()   ;for xgettext
+                                 ((_ str) str))))
+                (raise (condition
+                        (&message
+                         (message (format #f (G_ "'~a~{ ~a~}' exited \
+with status ~a; output follows:~%~%~{  ~a~%~}")
+                                          program args
+                                          (or (status:exit-val status)
+                                              status)
+                                          (reverse lines)))))))))))
+        (line
+         (loop (cons line lines)))))))
+
 
 ;;;
 ;;; Text substitution (aka. sed).
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 5172345..9c4b6de 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -37,6 +37,7 @@ gnu/installer/timezone.scm
 gnu/installer/user.scm
 gnu/installer/utils.scm
 gnu/packages/bootstrap.scm
+guix/build/utils.scm
 guix/scripts.scm
 guix/scripts/build.scm
 guix/discovery.scm
@@ -79,6 +80,4 @@ guix/channels.scm
 guix/profiles.scm
 guix/git.scm
 guix/deprecation.scm
-gnu/build/bootloader.scm
 nix/nix-daemon/guix-daemon.cc
-
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 5678bb6..61e6c44 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -21,8 +21,6 @@
 (define-module (test-build-utils)
   #:use-module (guix tests)
   #:use-module (guix build utils)
-  #:use-module ((gnu build bootloader)
-                #:select (invoke/quiet))
   #:use-module ((guix utils)
                 #:select (%current-system call-with-temporary-directory))
   #:use-module (gnu packages)