ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 @@ (define-module (guix gexp)
compiled-modules
define-gexp-compiler
gexp-compiler?))
gexp-compiler?
lower-inputs))
;;; Commentary:
;;;

155
guix/scripts/environment.scm
View file

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

20
tests/guix-environment.sh
View file

@ -58,4 +58,24 @@ then
--exec='echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$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