nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2013-05-24 23:53:06 +02:00
parent cba363bea8
commit 5dce82180b
2 changed files with 37 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/build-system/trivial.scm
View File

@ -25,31 +25,45 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (trivial-build-system)) #: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 (define* (trivial-build store name source inputs
#:key #:key
outputs guile system builder (modules '()) outputs guile system builder (modules '())
search-paths) search-paths)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored." 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 (build-expression->derivation store name system builder inputs
#:outputs outputs #:outputs outputs
#:modules modules #: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 (define trivial-build-system
(build-system (name 'trivial) (build-system (name 'trivial)
(description (description
"Trivial build system, to run arbitrary Scheme build expressions") "Trivial build system, to run arbitrary Scheme build expressions")
(build trivial-build) (build trivial-build)
(cross-build trivial-build))) (cross-build trivial-cross-build)))

11
tests/packages.scm
View File

@ -94,7 +94,7 @@
("d" ,d) ("d/x" "something.drv")) ("d" ,d) ("d/x" "something.drv"))
(pk 'x (package-transitive-inputs e)))))) (pk 'x (package-transitive-inputs e))))))
(test-skip (if (not %store) 5 0)) (test-skip (if (not %store) 6 0))
(test-assert "return values" (test-assert "return values"
(let-values (((drv-path drv) (let-values (((drv-path drv)
@ -203,6 +203,15 @@
(and (derivation-path? drv-path) (and (derivation-path? drv-path)
(derivation? drv)))) (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)) (unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
(test-skip 1)) (test-skip 1))
(test-assert "GNU Make, bootstrap" (test-assert "GNU Make, bootstrap"