diff options
| -rw-r--r-- | guix/inferior.scm | 12 | ||||
| -rw-r--r-- | tests/inferior.scm | 39 |
2 files changed, 47 insertions, 4 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm index 54200b75e4..20a86bbfda 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -156,12 +156,18 @@ custom binary port)." (close-port parent) (close-fdes 0) (close-fdes 1) + (close-fdes 2) (dup2 (fileno child) 0) (dup2 (fileno child) 1) ;; Mimic 'open-pipe*'. - (unless (file-port? (current-error-port)) - (close-fdes 2) - (dup2 (open-fdes "/dev/null" O_WRONLY) 2)) + (if (file-port? (current-error-port)) + (let ((error-port-fileno + (fileno (current-error-port)))) + (unless (eq? error-port-fileno 2) + (dup2 error-port-fileno + 2))) + (dup2 (open-fdes "/dev/null" O_WRONLY) + 2)) (apply execlp command command args)) (lambda () (primitive-_exit 127)))) 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") |