diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-07-04 16:16:41 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-07-04 16:16:41 +0200 |
commit | 42dcfca4cc424aa790d8fb62eb327782fd08aad7 (patch) | |
tree | 2decca0fb543cafd7a2d49ceda56ce9c85a4d57c /guix | |
parent | c6daa9cfb26552d36f451521b6380a07973a3b17 (diff) | |
parent | fc3f14927feb91f33324248107492ccbb4d43155 (diff) |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/derivations.scm | 33 | ||||
-rw-r--r-- | guix/profiles.scm | 3 | ||||
-rw-r--r-- | guix/store.scm | 12 |
3 files changed, 26 insertions, 22 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index ebeac31877..186d7a3f8f 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -320,8 +320,7 @@ substituter many times." ;; info is not already in cache. ;; Also, skip derivations marked as non-substitutable. (append-map (lambda (input) - (let ((drv (read-derivation-from-file - (derivation-input-path input)))) + (let ((drv (derivation-input-derivation input))) (if (substitutable-derivation? drv) (derivation-input-output-paths input) '()))) @@ -652,12 +651,10 @@ list of name/path pairs of its outputs." ;;; Derivation primitive. ;;; -(define derivation-path->base16-hash - (mlambda (file) - "Return a string containing the base16 representation of the hash of the -derivation at FILE." - (bytevector->base16-string - (derivation-hash (read-derivation-from-file file))))) +(define derivation-base16-hash + (mlambdaq (drv) + "Return a string containing the base16 representation of the hash of DRV." + (bytevector->base16-string (derivation-hash drv)))) (define (derivation/masked-inputs drv) "Assuming DRV is a regular derivation (not fixed-output), replace the file @@ -666,9 +663,8 @@ name of each input with that input's hash." (($ <derivation> outputs inputs sources system builder args env-vars) (let ((inputs (map (match-lambda - (($ <derivation-input> (= derivation-file-name path) - sub-drvs) - (let ((hash (derivation-path->base16-hash path))) + (($ <derivation-input> drv sub-drvs) + (let ((hash (derivation-base16-hash drv))) (make-derivation-input hash sub-drvs)))) inputs))) (make-derivation outputs @@ -886,8 +882,11 @@ long-running processes that know what they're doing. Use with care!" ;; Typically this is meant to be used by Cuirass and Hydra, which can clear ;; caches when they start evaluating packages for another architecture. (invalidate-memoization! derivation->bytevector) - (invalidate-memoization! derivation-path->base16-hash) - (hash-clear! %derivation-cache)) + (invalidate-memoization! derivation-base16-hash) + + ;; FIXME: Comment out to work around <https://bugs.gnu.org/36487>. + ;; (hash-clear! %derivation-cache) + ) (define derivation-properties (mlambdaq (drv) @@ -945,16 +944,14 @@ recursively." ;; in the format used in 'derivation' calls. (mlambda (input loop) (match input - (($ <derivation-input> (= derivation-file-name path) - (sub-drvs ...)) - (match (vhash-assoc path mapping) + (($ <derivation-input> drv (sub-drvs ...)) + (match (vhash-assoc (derivation-file-name drv) mapping) ((_ . (? derivation? replacement)) (cons replacement sub-drvs)) ((_ . replacement) (list replacement)) (#f - (let* ((drv (loop (read-derivation-from-file path)))) - (cons drv sub-drvs)))))))) + (cons (loop drv) sub-drvs))))))) (let loop ((drv drv)) (let* ((inputs (map (cut rewritten-input <> loop) diff --git a/guix/profiles.scm b/guix/profiles.scm index dfc9ba1ca0..f5c863945c 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -337,7 +338,7 @@ denoting a specific output of a package." (manifest (map (match-lambda - ((package output) + (((? package? package) output) (package->manifest-entry package output)) ((? package? package) (package->manifest-entry package)) diff --git a/guix/store.scm b/guix/store.scm index 8fa16499f8..52940ff751 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1783,6 +1783,9 @@ the store." ;; when using 'gexp->derivation' and co. (make-parameter #f)) +(define set-store-connection-object-cache! + (record-modifier <store-connection> 'object-cache)) + (define* (run-with-store store mval #:key (guile-for-build (%guile-for-build)) @@ -1798,9 +1801,12 @@ connection, and return the result." (%current-target-system target)) (call-with-values (lambda () (run-with-state mval store)) - (lambda (result store) - ;; Discard the state. - result)))) + (lambda (result new-store) + ;; Copy the object cache from NEW-STORE so we don't fully discard the + ;; state. + (let ((cache (store-connection-object-cache new-store))) + (set-store-connection-object-cache! store cache) + result))))) ;;; |