guix: inferior: Fix the behaviour of open-inferior #:error-port.

I'm looking at this as the Guix Data Service uses this behaviour to record and
display logs from inferior processes.

* guix/inferior.scm (open-bidirectional-pipe): Call dup2 for file descriptor
2, passing either the file number for the current error port, or a file
descriptor for /dev/null.
* tests/inferior.scm ("#:error-port stderr", "#:error-port pipe"): Add two new
tests that cover some of the #:error-port behaviour.

1 files changed, 38 insertions, 1 deletions

diff --git a/tests/inferior.scm b/tests/inferior.scm
index 56b2fcb7bc..963d405e33 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -30,7 +30,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim))
 
 (define %top-srcdir
   (dirname (search-path %load-path "guix.scm")))
@@ -315,4 +316,40 @@
     (close-inferior inferior)
     (map manifest-entry->list (manifest-entries manifest))))
 
+(test-equal "#:error-port stderr"
+  42
+  ;; There's a special case in open-bidirectional-pipe for
+  ;; (current-error-port) being stderr, so this test just checks that
+  ;; open-inferior doesn't raise an exception
+  (let ((inferior (open-inferior %top-builddir
+                                 #:command "scripts/guix"
+                                 #:error-port (current-error-port))))
+    (and (inferior? inferior)
+         (inferior-eval '(display "test" (current-error-port)) inferior)
+         (let ((result (inferior-eval '(apply * '(6 7)) inferior)))
+           (close-inferior inferior)
+           result))))
+
+(test-equal "#:error-port pipe"
+  "42"
+  (match (pipe)
+    ((port-to-read-from . port-to-write-to)
+
+     (setvbuf port-to-read-from 'line)
+     (setvbuf port-to-write-to 'line)
+
+     (let ((inferior (open-inferior %top-builddir
+                                    #:command "scripts/guix"
+                                    #:error-port port-to-write-to)))
+       (and (inferior? inferior)
+            (begin
+              (inferior-eval '(display "42\n" (current-error-port)) inferior)
+
+              (let loop ((line (read-line port-to-read-from)))
+                (if (string=? line "42")
+                    (begin
+                      (close-inferior inferior)
+                      line)
+                    (loop (read-line port-to-read-from))))))))))
+
 (test-end "inferior")