diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-02-28 16:42:34 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-02-28 22:47:42 +0100 |
commit | 297602513bf023e485a496bbb813cb9cafdf7475 (patch) | |
tree | 805f022d6ef1f61d88cfaedda83835e85fa9d8c7 /guix/build-system/trivial.scm | |
parent | bcc65510839d1b1800e0fd93b7e4c4d8f79a754c (diff) |
build-system/trivial: Add support for #:allowed-references.
* guix/build-system/trivial.scm (lower): Add #:allowed-references and
keep it in the 'arguments' field.
(trivial-build): Add #:allowed-references. Add
'canonicalize-reference'. Pass #:allowed-references to
'build-expression->derivation'.
(trivial-cross-build): Likewise.
* tests/packages.scm ("trivial with #:allowed-references"): New test.
Diffstat (limited to 'guix/build-system/trivial.scm')
-rw-r--r-- | guix/build-system/trivial.scm | 42 |
1 files changed, 37 insertions, 5 deletions
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index 350b1df553..b50ef7cd92 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +36,7 @@ (define* (lower name #:key source inputs native-inputs outputs system target - guile builder modules) + guile builder modules allowed-references) "Return a bag for NAME." (bag (name name) @@ -51,19 +51,36 @@ (build (if target trivial-cross-build trivial-build)) (arguments `(#:guile ,guile #:builder ,builder - #:modules ,modules)))) + #:modules ,modules + #:allowed-references ,allowed-references)))) (define* (trivial-build store name inputs #:key outputs guile system builder (modules '()) - search-paths) + search-paths allowed-references) "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is ignored." + (define canonicalize-reference + (match-lambda + ((? package? p) + (derivation->output-path (package-derivation store p system + #:graft? #f))) + (((? package? p) output) + (derivation->output-path (package-derivation store p system + #:graft? #f) + output)) + ((? string? output) + output))) + (build-expression->derivation store name builder #:inputs inputs #:system system #:outputs outputs #:modules modules + #:allowed-references + (and allowed-references + (map canonicalize-reference + allowed-references)) #:guile-for-build (guile-for-build store guile system))) @@ -71,14 +88,29 @@ ignored." #:key target native-drvs target-drvs outputs guile system builder (modules '()) - search-paths native-search-paths) + search-paths native-search-paths + allowed-references) "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is ignored." + (define canonicalize-reference + (match-lambda + ((? package? p) + (derivation->output-path (package-cross-derivation store p system))) + (((? package? p) output) + (derivation->output-path (package-cross-derivation store p system) + output)) + ((? string? output) + output))) + (build-expression->derivation store name builder #:inputs (append native-drvs target-drvs) #:system system #:outputs outputs #:modules modules + #:allowed-references + (and allowed-references + (map canonicalize-reference + allowed-references)) #:guile-for-build (guile-for-build store guile system))) |