From a93c1606312e41ffe509977502ce6055f40bc629 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Dec 2018 22:47:44 +0100 Subject: environment: Support package transformation options. Fixes . Reported by Adrien Guilbaud . * guix/scripts/environment.scm (show-help): Add call to 'show-transformation-options-help'. (%options): Add %TRANSFORMATION-OPTIONS. (options/resolve-packages): Add 'store' parameter. [transform, package->manifest-entry*]: New procedures. Use 'package->manifest-entry*' instead of 'package->manifest-entry'. (guix-environment): Move definition of 'manifest' within 'with-store'. * tests/guix-environment.sh: Add test. --- doc/guix.texi | 3 ++- guix/scripts/environment.scm | 24 ++++++++++++++++++------ tests/guix-environment.sh | 14 +++++++++++++- 3 files changed, 33 insertions(+), 8 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 1c26dc5a89..3ee65116b6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8350,7 +8350,8 @@ guix environment --container --share=$HOME=/exchange --ad-hoc guile -- guile @command{guix environment} also supports all of the common build options that @command{guix -build} supports (@pxref{Common Build Options}). +build} supports (@pxref{Common Build Options}) as well as package +transformation options (@pxref{Package Transformation Options}). @node Invoking guix publish diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 5965e3426e..7733fbcae4 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -162,6 +162,8 @@ COMMAND or an interactive shell in that environment.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -261,7 +263,9 @@ COMMAND or an interactive shell in that environment.\n")) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) - %standard-build-options)) + + (append %transformation-options + %standard-build-options))) (define (pick-all alist key) "Return a list of values in ALIST associated with KEY." @@ -274,7 +278,7 @@ COMMAND or an interactive shell in that environment.\n")) (_ memo))) '() alist)) -(define (options/resolve-packages opts) +(define (options/resolve-packages store opts) "Return OPTS with package specification strings replaced by manifest entries for the corresponding packages." (define (manifest-entry=? e1 e2) @@ -282,15 +286,21 @@ for the corresponding packages." (string=? (manifest-entry-output e1) (manifest-entry-output e2)))) + (define transform + (cut (options->transformation opts) store <>)) + + (define* (package->manifest-entry* package #:optional (output "out")) + (package->manifest-entry (transform package) output)) + (define (packages->outputs packages mode) (match packages ((? package? package) (if (eq? mode 'ad-hoc-package) - (list (package->manifest-entry package)) + (list (package->manifest-entry* package)) (package-environment-inputs package))) (((? package? package) (? string? output)) (if (eq? mode 'ad-hoc-package) - (list (package->manifest-entry package output)) + (list (package->manifest-entry* package output)) (package-environment-inputs package))) ((lst ...) (append-map (cut packages->outputs <> mode) lst)))) @@ -301,7 +311,7 @@ for the corresponding packages." (('package 'ad-hoc-package (? string? spec)) (let-values (((package output) (specification->package+output spec))) - (list (package->manifest-entry package output)))) + (list (package->manifest-entry* package output)))) (('package 'package (? string? spec)) (package-environment-inputs (specification->package+output spec))) @@ -654,7 +664,6 @@ message if any test fails." ;; within the container. '("/bin/sh") (list %default-shell)))) - (manifest (options/resolve-packages opts)) (mappings (pick-all opts 'file-system-mapping))) (when container? (assert-container-features)) @@ -666,6 +675,9 @@ message if any test fails." (with-store store (with-status-report print-build-event + (define manifest + (options/resolve-packages store opts)) + (set-build-options-from-command-line store opts) ;; Use the bootstrap Guile when requested. diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index b44aca099d..30b21028aa 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016, 2017 Ludovic Courtès +# Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès # # This file is part of GNU Guix. # @@ -118,6 +118,18 @@ fi # in its profile (e.g., for 'gzip'), but we have to accept them. guix environment guix --bootstrap -n +# Try program transformation options. +mkdir "$tmpdir/emacs-36.8" +drv="`guix environment --ad-hoc emacs -n 2>&1 | grep 'emacs.*\.drv'`" +transformed_drv="`guix environment --ad-hoc emacs --with-source="$tmpdir/emacs-36.8" -n 2>&1 | grep 'emacs.*\.drv'`" +test -n "$drv" +test "$drv" != "$transformed_drv" +case "$transformed_drv" in + *-emacs-36.8.drv) true;; + *) false;; +esac +rmdir "$tmpdir/emacs-36.8" + if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then # Compute the build environment for the initial GNU Make. -- cgit v1.2.3