gexp: 'lowered-gexp-guile' now returns a <derivation-input>.

* guix/derivations.scm (derivation-input-output-path): New procedure.
* guix/gexp.scm (lower-gexp): Wrap GUILE in a <derivation-input>.
(gexp->derivation): Adjust accordingly.
* guix/remote.scm (remote-pipe-for-gexp, remote-eval): Adjust
accordingly.
* tests/gexp.scm ("lower-gexp"): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2019-07-10 18:39:25 +02:00
parent 93c2a00739
commit b9373e2627
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 16 additions and 7 deletions

View File

@ -71,6 +71,7 @@
derivation-input-derivation
derivation-input-sub-derivations
derivation-input-output-paths
derivation-input-output-path
valid-derivation-input?
&derivation-error
@ -221,6 +222,13 @@ download with a fixed hash (aka. `fetchurl')."
(map (cut derivation->output-path drv <>)
sub-drvs))))
(define (derivation-input-output-path input)
"Return the output file name of INPUT. If INPUT has more than one outputs,
an error is raised."
(match input
(($ <derivation-input> drv (output))
(derivation->output-path drv output))))
(define (valid-derivation-input? store input)
"Return true if INPUT is valid--i.e., if all the outputs it requests are in
the store."

View File

@ -648,7 +648,7 @@ names and file names suitable for the #:allowed-references argument to
(sexp lowered-gexp-sexp) ;sexp
(inputs lowered-gexp-inputs) ;list of <derivation-input>
(sources lowered-gexp-sources) ;list of store items
(guile lowered-gexp-guile) ;<derivation> | #f
(guile lowered-gexp-guile) ;<derivation-input> | #f
(load-path lowered-gexp-load-path) ;list of store items
(load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items
@ -755,7 +755,7 @@ derivations--e.g., code evaluated for its side effects."
,@(map derivation-input exts)
,@(filter derivation-input? inputs))
(filter string? (cons modules inputs))
guile
(derivation-input guile '("out"))
load-path
load-compiled-path)))))
@ -889,7 +889,7 @@ The other arguments are as for 'derivation'."
(mbegin %store-monad
(set-grafting graft?) ;restore the initial setting
(raw-derivation name
(string-append (derivation->output-path guile)
(string-append (derivation-input-output-path guile)
"/bin/guile")
`("--no-auto-compile"
,@(append-map (lambda (directory)
@ -902,7 +902,7 @@ The other arguments are as for 'derivation'."
#:outputs outputs
#:env-vars env-vars
#:system system
#:inputs `(,(derivation-input guile '("out"))
#:inputs `(,guile
,@(lowered-gexp-inputs lowered)
,@(match graphs
(((_ . inputs) ...)

View File

@ -46,7 +46,7 @@
(compose object->string object->string))
(apply open-remote-pipe* session OPEN_READ
(string-append (derivation->output-path
(string-append (derivation-input-output-path
(lowered-gexp-guile lowered))
"/bin/guile")
"--no-auto-compile"
@ -95,7 +95,7 @@ remote store."
(remote -> (connect-to-remote-daemon session
socket-name)))
(define inputs
(cons (derivation-input (lowered-gexp-guile lowered))
(cons (lowered-gexp-guile lowered)
(lowered-gexp-inputs lowered)))
(define sources

View File

@ -868,7 +868,8 @@
"/lib/guile/2.0/site-ccache")
(lowered-gexp-load-compiled-path lexp))
(= 2 (length (lowered-gexp-load-compiled-path lexp)))
(eq? (lowered-gexp-guile lexp) (%guile-for-build)))))))
(eq? (derivation-input-derivation (lowered-gexp-guile lexp))
(%guile-for-build)))))))
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad