diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-10-28 19:21:50 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-10-28 21:30:27 +0200 |
| commit | 2015d3f042870860efef10e801b93eacc0742d38 (patch) | |
| tree | e442da4d986eab8a63c8dca758272768e92f9716 /guix/store.scm | |
| parent | 45b251fd045fe47dd65d42a269508ee50f26565d (diff) | |
| download | guix-2015d3f042870860efef10e801b93eacc0742d38.tar.gz | |
store: 'map/accumulate-builds' handler checks the store received.
This is a followup to b19250eec6f92308f237a09a43e8e3e2355345b9,
providing a proper fix for <https://issues.guix.gnu.org/46756>.
* guix/remote.scm (remote-eval): Revert b19250eec6f92308f237a09a43e8e3e2355345b9.
* guix/store.scm (build-accumulator): Turn into a procedure. Call
CONTINUE when the store is not eq? to the initial store.
(map/accumulate-builds): Adjust accordingly.
* tests/store.scm ("map/accumulate-builds and different store"): New test.
Diffstat (limited to 'guix/store.scm')
| -rw-r--r-- | guix/store.scm | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/guix/store.scm b/guix/store.scm index 89a719bcfc..7388953d15 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1349,11 +1349,14 @@ on the build output of a previous derivation." (things unresolved-things) (continuation unresolved-continuation)) -(define (build-accumulator continue store things mode) - "This build handler accumulates THINGS and returns an <unresolved> object." - (if (= mode (build-mode normal)) - (unresolved things continue) - (continue #t))) +(define (build-accumulator expected-store) + "Return a build handler that accumulates THINGS and returns an <unresolved> +object, only for build requests on EXPECTED-STORE." + (lambda (continue store things mode) + (if (and (eq? store expected-store) + (= mode (build-mode normal))) + (unresolved things continue) + (continue #t)))) (define* (map/accumulate-builds store proc lst #:key (cutoff 30)) @@ -1366,13 +1369,16 @@ CUTOFF is the threshold above which we stop accumulating unresolved nodes." ;; stumbling upon the same .drv build requests with many incoming edges. ;; See <https://bugs.gnu.org/49439>. + (define accumulator + (build-accumulator store)) + (define-values (result rest) (let loop ((lst lst) (result '()) (unresolved 0)) (match lst ((head . tail) - (match (with-build-handler build-accumulator + (match (with-build-handler accumulator (proc head)) ((? unresolved? obj) (if (>= unresolved cutoff) |