From 297602513bf023e485a496bbb813cb9cafdf7475 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 28 Feb 2018 16:42:34 +0100 Subject: 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. --- guix/build-system/trivial.scm | 42 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 37 insertions(+), 5 deletions(-) (limited to 'guix/build-system') 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 +;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès ;;; ;;; 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))) -- cgit v1.2.3