diff options
| -rw-r--r-- | doc/guix.texi | 17 | ||||
| -rw-r--r-- | guix/packages.scm | 71 | ||||
| -rw-r--r-- | guix/utils.scm | 6 | ||||
| -rw-r--r-- | tests/packages.scm | 9 |
4 files changed, 98 insertions, 5 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index c3aab812e2..1cf5849dd3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -919,6 +919,23 @@ must be a connection to the daemon, which operates on the store (@pxref{The Store}). @end deffn +@noindent +@cindex cross-compilation +Similarly, it is possible to compute a derivation that cross-builds a +package for some other system: + +@deffn {Scheme Procedure} package-cross-derivation @var{store} @ + @var{package} @var{target} [@var{system}] +Return the derivation path and corresponding @code{<derivation>} object +of @var{package} cross-built from @var{system} to @var{target}. + +@var{target} must be a valid GNU triplet denoting the target hardware +and operating system, such as @code{"mips64el-linux-gnu"} +(@pxref{Configuration Names, GNU configuration triplets,, configure, GNU +Configure and Build System}). +@end deffn + + @node The Store @section The Store diff --git a/guix/packages.scm b/guix/packages.scm index 242b912d5d..6321a58374 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -69,6 +69,8 @@ package-field-location package-transitive-inputs + package-transitive-target-inputs + package-transitive-native-inputs package-transitive-propagated-inputs package-source-derivation package-derivation @@ -268,6 +270,19 @@ with their propagated inputs, recursively." (package-inputs package) (package-propagated-inputs package)))) +(define (package-transitive-target-inputs package) + "Return the transitive target inputs of PACKAGE---i.e., its direct inputs +along with their propagated inputs, recursively. This only includes inputs +for the target system, and not native inputs." + (transitive-inputs (append (package-inputs package) + (package-propagated-inputs package)))) + +(define (package-transitive-native-inputs package) + "Return the transitive native inputs of PACKAGE---i.e., its direct inputs +along with their propagated inputs, recursively. This only includes inputs +for the host system (\"native inputs\"), and not target inputs." + (transitive-inputs (package-native-inputs package))) + (define (package-transitive-propagated-inputs package) "Return the propagated inputs of PACKAGE, and their propagated inputs, recursively." @@ -354,7 +369,8 @@ PACKAGE for SYSTEM." ;; Bind %CURRENT-SYSTEM so that thunked field values can refer ;; to it. - (parameterize ((%current-system system)) + (parameterize ((%current-system system) + (%current-target-system #f)) (match package (($ <package> name version source (= build-system-builder builder) args inputs propagated-inputs native-inputs self-native-input? @@ -380,10 +396,57 @@ PACKAGE for SYSTEM." #:outputs outputs #:system system (args)))))))) -(define* (package-cross-derivation store package cross-system +(define* (package-cross-derivation store package target #:optional (system (%current-system))) - ;; TODO - #f) + "Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix +system identifying string)." + (cached package (cons system target) + + ;; Bind %CURRENT-SYSTEM so that thunked field values can refer + ;; to it. + (parameterize ((%current-system system) + (%current-target-system target)) + (match package + (($ <package> name version source + (= build-system-cross-builder builder) + args inputs propagated-inputs native-inputs self-native-input? + outputs) + (let* ((inputs (package-transitive-target-inputs package)) + (input-drvs (map (cut expand-input + store package <> + system target) + inputs)) + (host (append (if self-native-input? + `(("self" ,package)) + '()) + (package-transitive-native-inputs package))) + (host-drvs (map (cut expand-input + store package <> system) + host)) + (all (append host inputs)) + (paths (delete-duplicates + (append-map (match-lambda + ((_ (? package? p) _ ...) + (package-search-paths p)) + (_ '())) + all))) + (npaths (delete-duplicates + (append-map (match-lambda + ((_ (? package? p) _ ...) + (package-native-search-paths + p)) + (_ '())) + all)))) + + (apply builder + store (package-full-name package) target + (and source + (package-source-derivation store source system)) + input-drvs host-drvs + #:search-paths paths + #:native-search-paths npaths + #:outputs outputs #:system system + (args)))))))) (define* (package-output store package output #:optional (system (%current-system))) diff --git a/guix/utils.scm b/guix/utils.scm index 25a392e6a8..2478fb6939 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -57,6 +57,7 @@ gnu-triplet->nix-system %current-system + %current-target-system version-compare version>? package-name->name+version @@ -310,6 +311,11 @@ returned by `config.guess'." ;; By default, this is equal to (gnu-triplet->nix-system %host-type). (make-parameter %system)) +(define %current-target-system + ;; Either #f or a GNU triplet representing the target system we are + ;; cross-building to. + (make-parameter #f)) + (define version-compare (let ((strverscmp (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) diff --git a/tests/packages.scm b/tests/packages.scm index 1dd7b91ae8..b439183eba 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -94,7 +94,7 @@ ("d" ,d) ("d/x" "something.drv")) (pk 'x (package-transitive-inputs e)))))) -(test-skip (if (not %store) 4 0)) +(test-skip (if (not %store) 5 0)) (test-assert "return values" (let-values (((drv-path drv) @@ -196,6 +196,13 @@ (equal? x (collect (package-derivation %store b))) (equal? x (collect (package-derivation %store c))))))) +(test-assert "package-cross-derivation" + (let-values (((drv-path drv) + (package-cross-derivation %store (dummy-package "p") + "mips64el-linux-gnu"))) + (and (derivation-path? drv-path) + (derivation? drv)))) + (unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) (test-skip 1)) (test-assert "GNU Make, bootstrap" |