diff options
| -rw-r--r-- | guix/gexp.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 155 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 20 |
3 files changed, 101 insertions, 78 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 0b5c43e2b8..09b51b3936 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -52,7 +52,9 @@ compiled-modules define-gexp-compiler - gexp-compiler?)) + gexp-compiler? + + lower-inputs)) ;;; Commentary: ;;; diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 007fde1606..e2ac086f6d 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -26,6 +26,7 @@ #: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 @@ #: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 @@ as 'HOME' and 'USER' are left untouched." (((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 @@ augment existing enviroment variables with additional search paths." (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 @@ packages." (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 @@ packages." (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))))))))))) diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 3d92d226f2..d04e6a6ea0 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -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 |