aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-08-17 21:20:11 +0200
committerLudovic Courtès <ludo@gnu.org>2014-08-17 21:20:11 +0200
commit68a61e9ffb4d1c8b54db68d61a3669bda50f1bd2 (patch)
tree3a30779964c4fac96b668ed00af174481b96b8a3
parentc90ddc8f811496e9da9ea1e6832a662bf767d6d9 (diff)
downloadguix-68a61e9ffb4d1c8b54db68d61a3669bda50f1bd2.tar
guix-68a61e9ffb4d1c8b54db68d61a3669bda50f1bd2.tar.gz
gexp: Add #:target parameter to 'gexp->derivation'.
* guix/gexp.scm (lower-inputs): Add #:system and #:target. Use 'package->cross-derivation' when TARGET is true. Honor SYSTEM. (gexp->derivation): Add #:target argument. Pass SYSTEM and TARGET to 'lower-inputs' and 'gexp->sexp'. (gexp->sexp): Add #:system and #:target. Pass them in recursive call and to 'package-file'. * tests/gexp.scm (gexp->sexp*): Add 'system' and 'target' parameters. ("gexp->derivation, cross-compilation"): New test.
-rw-r--r--doc/guix.texi6
-rw-r--r--guix/gexp.scm46
-rw-r--r--tests/gexp.scm21
3 files changed, 58 insertions, 15 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index a7803a4aee..8381b388cc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2218,13 +2218,15 @@ 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)] [#:inputs '()] @
+ [#:system (%current-system)] [#:target #f] [#:inputs '()] @
[#:hash #f] [#:hash-algo #f] @
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:references-graphs #f] [#:local-build? #f] @
[#:guile-for-build #f]
Return a derivation @var{name} that runs @var{exp} (a gexp) with
-@var{guile-for-build} (a derivation) on @var{system}.
+@var{guile-for-build} (a derivation) on @var{system}. When @var{target}
+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 from the current
diff --git a/guix/gexp.scm b/guix/gexp.scm
index c9f6cbe99a..f54221feab 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -81,14 +81,20 @@
(define raw-derivation
(store-lift derivation))
-(define (lower-inputs inputs)
- "Turn any package from INPUTS into a derivation; return the corresponding
-input list as a monadic value."
+(define* (lower-inputs inputs
+ #:key system target)
+ "Turn any package from INPUTS into a derivation for SYSTEM; return the
+corresponding input list as a monadic value. When TARGET is true, use it as
+the cross-compilation target triplet."
(with-monad %store-monad
(sequence %store-monad
(map (match-lambda
(((? package? package) sub-drv ...)
- (mlet %store-monad ((drv (package->derivation package)))
+ (mlet %store-monad
+ ((drv (if target
+ (package->cross-derivation package target
+ system)
+ (package->derivation package system))))
(return `(,drv ,@sub-drv))))
(((? origin? origin) sub-drv ...)
(mlet %store-monad ((drv (origin->derivation origin)))
@@ -99,7 +105,7 @@ input list as a monadic value."
(define* (gexp->derivation name exp
#:key
- system
+ system (target 'current)
hash hash-algo recursive?
(env-vars '())
(modules '())
@@ -107,7 +113,8 @@ input list as a monadic value."
references-graphs
local-build?)
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
-derivation) on SYSTEM.
+derivation) on SYSTEM. When TARGET is true, it is used as the
+cross-compilation target triplet for packages referred to by EXP.
Make MODULES available in the evaluation context of EXP; MODULES is a list of
names of Guile modules from the current search path to be copied in the store,
@@ -118,9 +125,21 @@ The other arguments are as for 'derivation'."
(define %modules modules)
(define outputs (gexp-outputs exp))
- (mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp)))
+ (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))
+
(system -> (or system (%current-system)))
- (sexp (gexp->sexp exp))
+ (target -> (if (eq? target 'current)
+ (%current-target-system)
+ target))
+ (inputs (lower-inputs (gexp-inputs exp)
+ #:system system
+ #:target target))
+ (sexp (gexp->sexp exp
+ #:system system
+ #:target target))
(builder (text-file (string-append name "-builder")
(object->string sexp)))
(modules (if (pair? %modules)
@@ -199,7 +218,9 @@ The other arguments are as for 'derivation'."
'()
(gexp-references exp)))
-(define* (gexp->sexp exp)
+(define* (gexp->sexp exp #:key
+ (system (%current-system))
+ (target (%current-target-system)))
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
and in the current monad setting (system type, etc.)"
(define (reference->sexp ref)
@@ -208,7 +229,10 @@ and in the current monad setting (system type, etc.)"
(((? derivation? drv) (? string? output))
(return (derivation->output-path drv output)))
(((? package? p) (? string? output))
- (package-file p #:output output))
+ (package-file p
+ #:output output
+ #:system system
+ #:target target))
(((? origin? o) (? string? output))
(mlet %store-monad ((drv (origin->derivation o)))
(return (derivation->output-path drv output))))
@@ -218,7 +242,7 @@ and in the current monad setting (system type, etc.)"
;; that trick.
(return `((@ (guile) getenv) ,output)))
((? gexp? exp)
- (gexp->sexp exp))
+ (gexp->sexp exp #:system system #:target target))
(((? string? str))
(return (if (direct-store-path? str) str ref)))
((refs ...)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index bdea4b8563..9cc7d41547 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -47,8 +47,11 @@
;; Make it the default.
(%guile-for-build guile-for-build)
-(define (gexp->sexp* exp)
- (run-with-store %store (gexp->sexp exp)
+(define* (gexp->sexp* exp #:optional
+ (system (%current-system)) target)
+ (run-with-store %store (gexp->sexp exp
+ #:system system
+ #:target target)
#:guile-for-build guile-for-build))
(define-syntax-rule (test-assertm name exp)
@@ -223,6 +226,20 @@
(mlet %store-monad ((drv mdrv))
(return (string=? system (derivation-system drv))))))
+(test-assertm "gexp->derivation, cross-compilation"
+ (mlet* %store-monad ((target -> "mips64el-linux")
+ (exp -> (gexp (list (ungexp coreutils)
+ (ungexp output))))
+ (xdrv (gexp->derivation "foo" exp
+ #:target target))
+ (refs ((store-lift references)
+ (derivation-file-name xdrv)))
+ (xcu (package->cross-derivation coreutils
+ target))
+ (cu (package->derivation coreutils)))
+ (return (and (member (derivation-file-name xcu) refs)
+ (not (member (derivation-file-name cu) refs))))))
+
(define shebang
(string-append "#!" (derivation->output-path guile-for-build)
"/bin/guile --no-auto-compile"))