inferior: Use 'spawn' on Guile 3.0.9+.

* guix/inferior.scm (open-bidirectional-pipe): When 'spawn' is defined,
use it instead of 'primitive-fork'.
This commit is contained in:
Ludovic Courtès 2023-01-26 10:18:31 +01:00
parent 0d22ea8282
commit fed3953d70
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -149,7 +149,21 @@ (define (open-bidirectional-pipe command . args)
;; the REPL process wouldn't get EOF on standard input. ;; the REPL process wouldn't get EOF on standard input.
(match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0) (match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0)
((parent . child) ((parent . child)
(match (primitive-fork) (if (defined? 'spawn)
(let* ((void (open-fdes "/dev/null" O_WRONLY))
(pid (catch 'system-error
(lambda ()
(spawn command (cons command args)
#:input child
#:output child
#:error (if (file-port? (current-error-port))
(current-error-port)
void)))
(const #f)))) ;can't exec, for instance ENOENT
(close-fdes void)
(close-port child)
(values parent pid))
(match (primitive-fork) ;Guile < 3.0.9
(0 (0
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
@ -175,7 +189,7 @@ (define (open-bidirectional-pipe command . args)
(primitive-_exit 127)))) (primitive-_exit 127))))
(pid (pid
(close-port child) (close-port child)
(values parent pid)))))) (values parent pid)))))))
(define* (inferior-pipe directory command error-port) (define* (inferior-pipe directory command error-port)
"Return two values: an input/output pipe on the Guix instance in DIRECTORY "Return two values: an input/output pipe on the Guix instance in DIRECTORY