tests: configuration: Add a test to cover 'unset regression.

[jackhill/guix/guix.git] / tests / inferior.scm

diff --git a/tests/inferior.scm b/tests/inferior.scm
index 9992077..963d405 100644 (file)
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -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")))
@@ -62,6 +63,20 @@
            (close-inferior inferior)
            (list a (inferior-object? b))))))
 
+(test-equal "close-inferior"
+  '((hello) (world))
+  (let* ((inferior1 (open-inferior %top-builddir #:command "scripts/guix"))
+         (lst1      (inferior-eval '(list 'hello) inferior1))
+         (inferior2 (open-inferior %top-builddir #:command "scripts/guix"))
+         (lst2      (inferior-eval '(list 'world) inferior2)))
+    ;; This call succeeds if and only if INFERIOR2 does not also hold a file
+    ;; descriptor to the socketpair beneath INFERIOR1; otherwise it blocks.
+    ;; See <https://issues.guix.gnu.org/55441#10>.
+    (close-inferior inferior1)
+
+    (close-inferior inferior2)
+    (list lst1 lst2)))
+
 (test-equal "&inferior-exception"
   '(a b c d)
   (let ((inferior (open-inferior %top-builddir
@@ -301,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")