gexp: Add #:graft? parameter to 'gexp->derivation'.

* guix/gexp.scm (gexp->derivation): Add #:graft? parameter and honor it.
* tests/gexp.scm ("gexp->derivation vs. grafts"): New test.
* doc/guix.texi (G-Expressions): Update 'gexp->derivation'
  documentation.
This commit is contained in:
Ludovic Courtès 2015-02-13 23:14:05 +01:00
parent b8bedf6051
commit ce45eb4c38
3 changed files with 58 additions and 32 deletions

View File

@ -2580,7 +2580,7 @@ below allow you to do that (@pxref{The Store Monad}, for more
information about monads.)
@deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @
[#:system (%current-system)] [#:target #f] [#:inputs '()] @
[#:system (%current-system)] [#:target #f] [#:graft? #t] @
[#:hash #f] [#:hash-algo #f] @
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:module-path @var{%load-path}] @
@ -2591,12 +2591,15 @@ Return a derivation @var{name} that runs @var{exp} (a gexp) with
is true, it is used as the cross-compilation target triplet for packages
referred to by @var{exp}.
Make @var{modules} available in the evaluation context of @var{EXP};
@var{MODULES} is a list of names of Guile modules searched in
@var{MODULE-PATH} to be copied in the store, compiled, and made available in
Make @var{modules} available in the evaluation context of @var{exp};
@var{modules} is a list of names of Guile modules searched in
@var{module-path} to be copied in the store, compiled, and made available in
the load path during the execution of @var{exp}---e.g., @code{((guix
build utils) (guix build gnu-build-system))}.
@var{graft?} determines whether packages referred to by @var{exp} should be grafted when
applicable.
When @var{references-graphs} is true, it must be a list of tuples of one of the
following forms:

View File

@ -153,6 +153,7 @@ names and file names suitable for the #:allowed-references argument to
(modules '())
(module-path %load-path)
(guile-for-build (%guile-for-build))
(graft? (%graft?))
references-graphs
allowed-references
local-build?)
@ -165,6 +166,9 @@ names of Guile modules searched in MODULE-PATH to be copied in the store,
compiled, and made available in the load path during the execution of
EXP---e.g., '((guix build utils) (guix build gnu-build-system)).
GRAFT? determines whether packages referred to by EXP should be grafted when
applicable.
When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the
following forms:
@ -198,10 +202,10 @@ The other arguments are as for 'derivation'."
(cons file-name thing)))
graphs))
(mlet* %store-monad (;; The following binding is here to force
;; '%current-system' and '%current-target-system' to be
;; looked up at >>= time.
(unused (return #f))
(mlet* %store-monad (;; The following binding forces '%current-system' and
;; '%current-target-system' to be looked up at >>=
;; time.
(graft? (set-grafting graft?))
(system -> (or system (%current-system)))
(target -> (if (eq? target 'current)
@ -245,30 +249,32 @@ The other arguments are as for 'derivation'."
(return guile-for-build)
(package->derivation (default-guile)
system))))
(raw-derivation name
(string-append (derivation->output-path guile)
"/bin/guile")
`("--no-auto-compile"
,@(if (pair? %modules)
`("-L" ,(derivation->output-path modules)
"-C" ,(derivation->output-path compiled))
'())
,builder)
#:outputs outputs
#:env-vars env-vars
#:system system
#:inputs `((,guile)
(,builder)
,@(if modules
`((,modules) (,compiled) ,@inputs)
inputs)
,@(match graphs
(((_ . inputs) ...) inputs)
(_ '())))
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs (and=> graphs graphs-file-names)
#:allowed-references allowed
#:local-build? local-build?)))
(mbegin %store-monad
(set-grafting graft?) ;restore the initial setting
(raw-derivation name
(string-append (derivation->output-path guile)
"/bin/guile")
`("--no-auto-compile"
,@(if (pair? %modules)
`("-L" ,(derivation->output-path modules)
"-C" ,(derivation->output-path compiled))
'())
,builder)
#:outputs outputs
#:env-vars env-vars
#:system system
#:inputs `((,guile)
(,builder)
,@(if modules
`((,modules) (,compiled) ,@inputs)
inputs)
,@(match graphs
(((_ . inputs) ...) inputs)
(_ '())))
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs (and=> graphs graphs-file-names)
#:allowed-references allowed
#:local-build? local-build?))))
(define* (gexp-inputs exp #:optional (references gexp-references))
"Return the input list for EXP, using REFERENCES to get its list of

View File

@ -249,6 +249,23 @@
(equal? refs (list (dirname (dirname guile))))
(equal? refs2 (list file))))))
(test-assertm "gexp->derivation vs. grafts"
(mlet* %store-monad ((p0 -> (dummy-package "dummy"
(arguments
'(#:implicit-inputs? #f))))
(r -> (package (inherit p0) (name "DuMMY")))
(p1 -> (package (inherit p0) (replacement r)))
(exp0 -> (gexp (frob (ungexp p0) (ungexp output))))
(exp1 -> (gexp (frob (ungexp p1) (ungexp output))))
(void (set-guile-for-build %bootstrap-guile))
(drv0 (gexp->derivation "t" exp0))
(drv1 (gexp->derivation "t" exp1))
(drv1* (gexp->derivation "t" exp1 #:graft? #f)))
(return (and (not (string=? (derivation->output-path drv0)
(derivation->output-path drv1)))
(string=? (derivation->output-path drv0)
(derivation->output-path drv1*))))))
(test-assertm "gexp->derivation, composed gexps"
(mlet* %store-monad ((exp0 -> (gexp (begin
(mkdir (ungexp output))