From b4c4a6acb1204ee53e95744236ee89985db32f91 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 25 Jun 2022 18:14:07 +0100 Subject: 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. --- tests/inferior.scm | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) (limited to 'tests') 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") -- cgit 1.4.1