From b9373e262730578ba6c3805ffe44900f10bc655c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 10 Jul 2019 18:39:25 +0200 Subject: [PATCH] gexp: 'lowered-gexp-guile' now returns a . * guix/derivations.scm (derivation-input-output-path): New procedure. * guix/gexp.scm (lower-gexp): Wrap GUILE in a . (gexp->derivation): Adjust accordingly. * guix/remote.scm (remote-pipe-for-gexp, remote-eval): Adjust accordingly. * tests/gexp.scm ("lower-gexp"): Adjust accordingly. --- guix/derivations.scm | 8 ++++++++ guix/gexp.scm | 8 ++++---- guix/remote.scm | 4 ++-- tests/gexp.scm | 3 ++- 4 files changed, 16 insertions(+), 7 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 23d058e832..92d50503ce 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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 + (($ 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." diff --git a/guix/gexp.scm b/guix/gexp.scm index 52643bd684..eef308b000 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -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 (sources lowered-gexp-sources) ;list of store items - (guile lowered-gexp-guile) ; | #f + (guile lowered-gexp-guile) ; | #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) ...) diff --git a/guix/remote.scm b/guix/remote.scm index 52ced16871..d49ee91b38 100644 --- a/guix/remote.scm +++ b/guix/remote.scm @@ -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 diff --git a/tests/gexp.scm b/tests/gexp.scm index a1f79e3435..460afe7f59 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -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