futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

packages: Implement `package-cross-derivation'.

Browse Source 
* guix/packages.scm (package-transitive-target-inputs,
  package-transitive-native-inputs): New procedures.
  (package-derivation): Parametrize `%current-target-system'.
  (package-cross-derivation): Implement.
* guix/utils.scm (%current-target-system): New variable.
* tests/packages.scm ("package-cross-derivation"): New test.
* doc/guix.texi (Defining Packages): Document
  `package-cross-derivation'.
This commit is contained in:
Ludovic Courtès 2013-05-24 22:21:24 +02:00
parent 17bb886ff4
commit 9c1edabd8b
4 changed files with 98 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
doc/guix.texi
View File

@ -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

71
guix/packages.scm
View File

@ -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)))

6
guix/utils.scm
View File

@ -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))

9
tests/packages.scm
View File

@ -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"