channels: Do not fail when the inferior lacks 'guix repl'.

Fixes <https://bugs.gnu.org/34637>.
Reported by Martin Flack <martin.flack@gmail.com>.

Previously we'd fail to build the package cache for old versions of Guix
that lack 'guix repl'.  Now we simply ignore the issue and keep going
without a cache.

* guix/inferior.scm (gexp->derivation-in-inferior): Add
 #:silent-failure? and honor it.
[drop-extra-keyword]: New procedure.
Use it.
* guix/channels.scm (package-cache-file): Pass #:silent-failure? #t.
This commit is contained in:
Ludovic Courtès 2019-03-08 12:25:25 +01:00
parent 910aaa3b86
commit 4035fcba93
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 28 additions and 3 deletions

View File

@ -477,6 +477,12 @@ be used as a profile hook."
(gexp->derivation-in-inferior "guix-package-cache" build
profile
;; If the Guix in PROFILE is too old and
;; lacks 'guix repl', don't build the cache
;; instead of failing.
#:silent-failure? #t
#:properties '((type . profile-hook)
(hook . package-cache))
#:local-build? #t)))

View File

@ -513,10 +513,15 @@ PACKAGE must be live."
(inferior-package->derivation package system #:target target))
(define* (gexp->derivation-in-inferior name exp guix
#:key silent-failure?
#:allow-other-keys
#:rest rest)
"Return a derivation that evaluates EXP with GUIX, an instance of Guix as
returned for example by 'channel-instances->derivation'. Other arguments are
passed as-is to 'gexp->derivation'."
passed as-is to 'gexp->derivation'.
When SILENT-FAILURE? is true, create an empty output directory instead of
failing when GUIX is too old and lacks the 'guix repl' command."
(define script
;; EXP wrapped with a proper (set! %load-path …) prologue.
(scheme-file "inferior-script.scm" exp))
@ -539,9 +544,23 @@ passed as-is to 'gexp->derivation'."
(write `(primitive-load #$script) pipe)
(unless (zero? (close-pipe pipe))
(error "inferior failed" #+guix)))))
(if #$silent-failure?
(mkdir #$output)
(error "inferior failed" #+guix))))))
(apply gexp->derivation name trampoline rest))
(define (drop-extra-keyword lst)
(let loop ((lst lst)
(result '()))
(match lst
(()
(reverse result))
((#:silent-failure? _ . rest)
(loop rest result))
((kw value . tail)
(loop tail (cons* value kw result))))))
(apply gexp->derivation name trampoline
(drop-extra-keyword rest)))
;;;