;;; 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.
;;;
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages sqlite)
#: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")))
(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
(list (inferior-package-derivation %store guile "x86_64-linux")
(inferior-package-derivation %store guile "armhf-linux")))))
+(unless (package-replacement sqlite)
+ (test-skip 1))
+
+(test-equal "inferior-package-replacement"
+ (package-derivation %store
+ (package-replacement sqlite)
+ "x86_64-linux")
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (packages (inferior-packages inferior)))
+ (match (lookup-inferior-packages inferior
+ (package-name sqlite)
+ (package-version sqlite))
+ ((inferior-sqlite rest ...)
+ (inferior-package-derivation %store
+ (inferior-package-replacement
+ inferior-sqlite)
+ "x86_64-linux")))))
+
(test-equal "inferior-package->manifest-entry"
(manifest-entry->list (package->manifest-entry
(first (find-best-packages-by-name "guile" #f))))
(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")