diff options
| -rw-r--r-- | guix/build-system/trivial.scm | 40 | ||||
| -rw-r--r-- | tests/packages.scm | 11 |
2 files changed, 37 insertions, 14 deletions
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index 2eb15aa2e0..af54f51419 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -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))) diff --git a/tests/packages.scm b/tests/packages.scm index b439183eba..bec9de5b45 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) 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" |