futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

environment: Add only the specified outputs of the dependencies.

Browse Source 
Before that, 'guix environment guile' (for instance) would define environment
variables that would refer to the "include" output of Bash, the "debug" output
of libgc, etc., even though these are not listed as inputs in the recipe of
'guile'.

* guix/gexp.scm (lower-inputs): Export.
* guix/scripts/environment.scm (evaluate-input-search-paths): Remove
  'derivations' parameter; add 'search-paths'.  Expect 'inputs' to be
  a list of tuples.  Adjust callers.
  (create-environment): Remove 'derivations' parameter; add 'search-paths'.
  (show-search-paths): Likewise.
  (package+propagated-inputs): New procedure.
  (packages->transitive-inputs, packages+propagated-inputs): Remove.
  (build-inputs): Expect INPUTS to be a list of derivation tuples.
  (guix-environment): Compute INPUTS using 'package+propagated-inputs',
  'package->bag', and 'bag-transitive-inputs'.  Move 'run-with-store' higher.
* tests/guix-environment.sh: Add test with FINDUTILS-BOOT0.
This commit is contained in:
Ludovic Courtès 2015-06-30 23:23:06 +02:00
parent cad2526449
commit 6b6298ae39
3 changed files with 101 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
guix/gexp.scm
View File

@ -52,7 +52,9 @@
compiled-modules compiled-modules
define-gexp-compiler define-gexp-compiler
gexp-compiler?)) gexp-compiler?
lower-inputs))
;;; Commentary: ;;; Commentary:
;;; ;;;

131
guix/scripts/environment.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-inputs))
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -36,20 +37,19 @@
#:use-module (srfi srfi-98) #:use-module (srfi srfi-98)
#:export (guix-environment)) #:export (guix-environment))
(define (evaluate-input-search-paths inputs derivations) (define (evaluate-input-search-paths inputs search-paths)
"Evaluate the native search paths of INPUTS, a list of packages, of the "Evaluate SEARCH-PATHS, a list of search-path specifications, for the
outputs of DERIVATIONS, and return a list of search-path/value pairs." directories corresponding to INPUTS, a list of (DERIVATION) or (DERIVATION
(let ((directories (append-map (lambda (drv) OUTPUT) tuples."
(map (match-lambda (let ((directories (map (match-lambda
((_ . output) (((? derivation? drv))
(derivation-output-path output))) (derivation->output-path drv))
(derivation-outputs drv))) (((? derivation? drv) output)
derivations)) (derivation->output-path drv output))
(paths (cons $PATH (((? string? item))
(delete-duplicates item))
(append-map package-native-search-paths inputs)))
inputs))))) (evaluate-search-paths search-paths directories)))
(evaluate-search-paths paths directories)))
;; Protect some env vars from purification. Borrowed from nix-shell. ;; Protect some env vars from purification. Borrowed from nix-shell.
(define %precious-variables (define %precious-variables
@ -64,10 +64,11 @@ as 'HOME' and 'USER' are left untouched."
(((names . _) ...) (((names . _) ...)
names))))) names)))))
(define (create-environment inputs derivations pure?) (define (create-environment inputs paths pure?)
"Set the needed environment variables for all packages within INPUTS. When "Set the environment variables specified by PATHS for all the packages
PURE? is #t, unset the variables in the current environment. Otherwise, within INPUTS. When PURE? is #t, unset the variables in the current
augment existing enviroment variables with additional search paths." environment. Otherwise, augment existing enviroment variables with additional
search paths."
(when pure? (purify-environment)) (when pure? (purify-environment))
(for-each (match-lambda (for-each (match-lambda
((($ <search-path-specification> variable _ separator) . value) ((($ <search-path-specification> variable _ separator) . value)
@ -76,19 +77,24 @@ augment existing enviroment variables with additional search paths."
(if (and current (not pure?)) (if (and current (not pure?))
(string-append value separator current) (string-append value separator current)
value))))) value)))))
(evaluate-input-search-paths inputs derivations))) (evaluate-input-search-paths inputs paths)))
(define (show-search-paths inputs derivations pure?) (define (show-search-paths inputs search-paths pure?)
"Display the needed search paths to build an environment that contains the "Display SEARCH-PATHS applied to the packages specified by INPUTS, a list of
packages within INPUTS. When PURE? is #t, do not augment existing environment (DERIVATION) or (DERIVATION OUTPUT) tuples. When PURE? is #t, do not augment
variables with additional search paths." existing environment variables with additional search paths."
(for-each (match-lambda (for-each (match-lambda
((search-path . value) ((search-path . value)
(display (display
(search-path-definition search-path value (search-path-definition search-path value
#:kind (if pure? 'exact 'prefix))) #:kind (if pure? 'exact 'prefix)))
(newline))) (newline)))
(evaluate-input-search-paths inputs derivations))) (evaluate-input-search-paths inputs search-paths)))
(define (package+propagated-inputs package)
"Return the union of PACKAGE and its transitive propagated inputs."
`((,(package-name package) ,package)
,@(package-transitive-propagated-inputs package)))
(define (show-help) (define (show-help)
(display (_ "Usage: guix environment [OPTION]... PACKAGE... (display (_ "Usage: guix environment [OPTION]... PACKAGE...
@ -184,47 +190,23 @@ packages."
(opt opt)) (opt opt))
opts)) opts))
(define (packages->transitive-inputs packages)
"Return a list of the transitive inputs for all PACKAGES."
(define (transitive-inputs package)
(filter-map (match-lambda
((or (_ (? package? package))
(_ (? package? package) _))
package)
(_ #f))
(bag-transitive-inputs
(package->bag package))))
(delete-duplicates
(append-map transitive-inputs packages)))
(define (packages+propagated-inputs packages)
"Return a list containing PACKAGES plus all of their propagated inputs."
(delete-duplicates
(append packages
(map (match-lambda
((or (_ (? package? package))
(_ (? package? package) _))
package)
(_ #f))
(append-map package-transitive-propagated-inputs
packages)))))
(define (build-inputs inputs opts) (define (build-inputs inputs opts)
"Build the packages in INPUTS using the build options in OPTS." "Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION
OUTPUT) tuples, using the build options in OPTS."
(let ((substitutes? (assoc-ref opts 'substitutes?)) (let ((substitutes? (assoc-ref opts 'substitutes?))
(dry-run? (assoc-ref opts 'dry-run?))) (dry-run? (assoc-ref opts 'dry-run?)))
(mlet* %store-monad ((drvs (sequence %store-monad (match inputs
(map package->derivation inputs)))) (((derivations _ ...) ...)
(mbegin %store-monad (mbegin %store-monad
(show-what-to-build* drvs (show-what-to-build* derivations
#:use-substitutes? substitutes? #:use-substitutes? substitutes?
#:dry-run? dry-run?) #:dry-run? dry-run?)
(if dry-run? (if dry-run?
(return #f) (return #f)
(mbegin %store-monad (mbegin %store-monad
(set-build-options-from-command-line* opts) (set-build-options-from-command-line* opts)
(built-derivations drvs) (built-derivations derivations)
(return drvs))))))) (return derivations))))))))
;; Entry point. ;; Entry point.
(define (guix-environment . args) (define (guix-environment . args)
@ -239,19 +221,38 @@ packages."
(command (assoc-ref opts 'exec)) (command (assoc-ref opts 'exec))
(packages (pick-all (options/resolve-packages opts) 'package)) (packages (pick-all (options/resolve-packages opts) 'package))
(inputs (if ad-hoc? (inputs (if ad-hoc?
(packages+propagated-inputs packages) (append-map package+propagated-inputs packages)
(packages->transitive-inputs packages)))) (append-map (compose bag-transitive-inputs
package->bag)
packages)))
(paths (delete-duplicates
(cons $PATH
(append-map (match-lambda
((label (? package? p) _ ...)
(package-native-search-paths p))
(_
'()))
inputs))
eq?)))
(with-store store (with-store store
(define drvs
(run-with-store store (run-with-store store
(mlet %store-monad ((inputs (lower-inputs
(map (match-lambda
((label item)
(list item))
((label item output)
(list item output)))
inputs)
#:system (%current-system))))
(mbegin %store-monad (mbegin %store-monad
(set-guile-for-build (default-guile)) ;; First build INPUTS. This is necessary even for
(build-inputs inputs opts)))) ;; --search-paths.
(build-inputs inputs opts)
(cond ((assoc-ref opts 'dry-run?) (cond ((assoc-ref opts 'dry-run?)
#t) (return #t))
((assoc-ref opts 'search-paths) ((assoc-ref opts 'search-paths)
(show-search-paths inputs drvs pure?)) (show-search-paths inputs paths pure?)
(return #t))
(else (else
(create-environment inputs drvs pure?) (create-environment inputs paths pure?)
(system command))))))) (return (system command)))))))))))

20
tests/guix-environment.sh
View File

@ -58,4 +58,24 @@ then
--exec='echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" --exec='echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c" ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c"
cmp "$tmpdir/b" "$tmpdir/c" cmp "$tmpdir/b" "$tmpdir/c"
rm "$tmpdir"/*
# Compute the build environment for the initial GNU Findutils.
guix environment -e '(@@ (gnu packages commencement) findutils-boot0)' \
--no-substitutes --search-paths --pure > "$tmpdir/a"
# Make sure the bootstrap binaries are all listed where they belong.
grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a"
grep -E '^export PATH=.*-make-boot0-[0-9.]+/bin' "$tmpdir/a"
grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a"
grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a"
grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a"
# The following test assumes 'make-boot0' has a "debug" output.
make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`"
test "x$make_boot0_debug" != "x"
# Make sure the "debug" output is not listed.
if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi
fi fi