build-system/trivial: Implement the cross-build protocol.
* guix/build-system/trivial.scm (guile-for-build): New procedure. (trivial-build): Use it. (trivial-cross-build): New procedure. (trivial-build-system): Use it.
This commit is contained in:
parent
cba363bea8
commit
5dce82180b
|
@ -25,31 +25,45 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:export (trivial-build-system))
|
||||
|
||||
(define (guile-for-build store guile system)
|
||||
(match guile
|
||||
((? package?)
|
||||
(package-derivation store guile system))
|
||||
((and (? string?) (? derivation-path?))
|
||||
guile)
|
||||
(#f ; the default
|
||||
(let* ((distro (resolve-interface '(gnu packages base)))
|
||||
(guile (module-ref distro 'guile-final)))
|
||||
(package-derivation store guile system)))))
|
||||
|
||||
(define* (trivial-build store name source inputs
|
||||
#:key
|
||||
outputs guile system builder (modules '())
|
||||
search-paths)
|
||||
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
|
||||
ignored."
|
||||
(define guile-for-build
|
||||
(match guile
|
||||
((? package?)
|
||||
(package-derivation store guile system))
|
||||
((and (? string?) (? derivation-path?))
|
||||
guile)
|
||||
(#f ; the default
|
||||
(let* ((distro (resolve-interface '(gnu packages base)))
|
||||
(guile (module-ref distro 'guile-final)))
|
||||
(package-derivation store guile system)))))
|
||||
|
||||
(build-expression->derivation store name system builder inputs
|
||||
#:outputs outputs
|
||||
#:modules modules
|
||||
#:guile-for-build guile-for-build))
|
||||
#:guile-for-build
|
||||
(guile-for-build store guile system)))
|
||||
|
||||
(define* (trivial-cross-build store name target source inputs native-inputs
|
||||
#:key
|
||||
outputs guile system builder (modules '())
|
||||
search-paths native-search-paths)
|
||||
"Like `trivial-build', but in a cross-compilation context."
|
||||
(build-expression->derivation store name system
|
||||
`(begin (define %target ,target) ,builder)
|
||||
(append native-inputs inputs)
|
||||
#:outputs outputs
|
||||
#:modules modules
|
||||
#:guile-for-build
|
||||
(guile-for-build store guile system)))
|
||||
|
||||
(define trivial-build-system
|
||||
(build-system (name 'trivial)
|
||||
(description
|
||||
"Trivial build system, to run arbitrary Scheme build expressions")
|
||||
(build trivial-build)
|
||||
(cross-build trivial-build)))
|
||||
(cross-build trivial-cross-build)))
|
||||
|
|
|
@ -94,7 +94,7 @@
|
|||
("d" ,d) ("d/x" "something.drv"))
|
||||
(pk 'x (package-transitive-inputs e))))))
|
||||
|
||||
(test-skip (if (not %store) 5 0))
|
||||
(test-skip (if (not %store) 6 0))
|
||||
|
||||
(test-assert "return values"
|
||||
(let-values (((drv-path drv)
|
||||
|
@ -203,6 +203,15 @@
|
|||
(and (derivation-path? drv-path)
|
||||
(derivation? drv))))
|
||||
|
||||
(test-assert "package-cross-derivation, trivial-build-system"
|
||||
(let ((p (package (inherit (dummy-package "p"))
|
||||
(build-system trivial-build-system)
|
||||
(arguments '(#:builder (exit 1))))))
|
||||
(let-values (((drv-path drv)
|
||||
(package-cross-derivation %store 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"
|
||||
|
|
Loading…
Reference in New Issue