diff options
| -rw-r--r-- | doc/guix.texi | 38 | ||||
| -rw-r--r-- | guix/gexp.scm | 19 | ||||
| -rw-r--r-- | tests/gexp.scm | 24 |
3 files changed, 80 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index b742a3d5b2..a760d627eb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12197,6 +12197,11 @@ This is like the form above, but referring explicitly to the @var{output} of @var{obj}---this is useful when @var{obj} produces multiple outputs (@pxref{Packages with Multiple Outputs}). +Sometimes a gexp unconditionally refers to the @code{"out"} output, but +the user of that gexp would still like to insert a reference to another +output. The @code{gexp-input} procedure aims to address that. +@xref{gexp-input}. + @item #+@var{obj} @itemx #+@var{obj}:output @itemx (ungexp-native @var{obj}) @@ -12590,6 +12595,39 @@ The example above returns an object that corresponds to the i686 build of Coreutils, regardless of the current value of @code{%current-system}. @end defmac +@anchor{gexp-input} +@deffn {Procedure} gexp-input @var{obj} [@var{output}] [#:native? #f] +Return a @dfn{gexp input} record for the given @var{output} of file-like +object @var{obj}, with @code{#:native?} determining whether this is a +native reference (as with @code{ungexp-native}) or not. + +This procedure is helpful when you want to pass a reference to a +specific output of an object to some procedure that may not know about +that output. For example, assume you have this procedure, which takes +one file-like object: + +@lisp +(define (make-symlink target) + (computed-file "the-symlink" + #~(symlink #$target #$output))) +@end lisp + +Here @code{make-symlink} can only ever refer to the default output of +@var{target}---the @code{"out"} output (@pxref{Packages with Multiple +Outputs}). To have it refer to, say, the @code{"lib"} output of the +@code{hwloc} package, you can call it like so: + +@lisp +(make-symlink (gexp-input hwloc "lib")) +@end lisp + +You can also compose it like any other file-like object: + +@lisp +(make-symlink + (file-append (gexp-input hwloc "lib") "/lib/libhwloc.so")) +@end lisp +@end deffn Of course, in addition to gexps embedded in ``host'' code, there are also modules containing build tools. To make it clear that they are diff --git a/guix/gexp.scm b/guix/gexp.scm index 0fe4f1c98a..a7f4256d24 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> @@ -775,6 +775,23 @@ x86_64-linux when COREUTILS is lowered." whether this should be considered a \"native\" input or not." (%gexp-input thing output native?)) +;; Allow <gexp-input>s to be used within gexps. This is useful when willing +;; to force a specific reference to an object, as in (gexp-input hwloc "bin"), +;; which forces a reference to the "bin" output of 'hwloc' instead of leaving +;; it up to the recipient to pick the right output. +(define-gexp-compiler gexp-input-compiler <gexp-input> + compiler => (lambda (obj system target) + (match obj + (($ <gexp-input> thing output native?) + (lower-object thing system + #:target (and (not native?) target))))) + expander => (lambda (obj lowered output/ignored) + (match obj + (($ <gexp-input> thing output native?) + (let ((expand (or (lookup-expander thing) + (lookup-expander lowered)))) + (expand thing lowered output)))))) + ;; Reference to one of the derivation's outputs, for gexps used in ;; derivations. (define-record-type <gexp-output> diff --git a/tests/gexp.scm b/tests/gexp.scm index 0e3c446576..871e5f7abb 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -393,6 +393,30 @@ (list item)) (null? (lowered-gexp-inputs lexp))))) +(test-equal "gexp references non-existent output" + "no-default-output" + (guard (c ((derivation-missing-output-error? c) + (derivation-name (derivation-error-derivation c)))) + (let* ((obj (computed-file "no-default-output" + #~(mkdir #$output:bar))) + (exp #~(symlink #$obj #$output)) + (drv (run-with-store %store (lower-gexp exp)))) + (pk 'oops! drv #f)))) + +(test-assert "gexp-input, as first-class input" + ;; Insert a <gexp-input> record in a gexp as a way to specify which output + ;; of OBJ should be used. + (let* ((obj (computed-file "foo" #~(mkdir #$output:bar))) + (exp #~(list #$(gexp-input obj "bar"))) + (drv (run-with-store %store (lower-object obj))) + (item (derivation->output-path drv "bar")) + (lexp (run-with-store %store (lower-gexp exp)))) + (and (match (lowered-gexp-inputs lexp) + ((input) + (eq? (derivation-input-derivation input) drv))) + (equal? (lowered-gexp-sexp lexp) + `(list ,item))))) + (test-assertm "with-parameters for %current-system" (mlet* %store-monad ((system -> (match (%current-system) ("aarch64-linux" "x86_64-linux") |