summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-10-28 19:21:50 +0200
committerLudovic Courtès <ludo@gnu.org>2021-10-28 21:30:27 +0200
commit2015d3f042870860efef10e801b93eacc0742d38 (patch)
treee442da4d986eab8a63c8dca758272768e92f9716 /guix
parent45b251fd045fe47dd65d42a269508ee50f26565d (diff)
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')
-rw-r--r--guix/remote.scm11
-rw-r--r--guix/store.scm18
2 files changed, 13 insertions, 16 deletions
diff --git a/guix/remote.scm b/guix/remote.scm
index 37e9827084..f6adb22846 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -146,15 +146,6 @@ remote store."
sources)))
(mbegin %store-monad
((store-lift send-files) to-send remote #:recursive? #t)
-
- ;; Build handlers are not tied to a specific <store-connection>.
- ;; If a handler is already installed, it might want to go ahead
- ;; and build, but on the local <store-connection> instead of
- ;; REMOTE. To avoid that, install a build handler that does
- ;; nothing.
- (return (with-build-handler (lambda (continue . _)
- (continue #t))
- (build-derivations remote inputs)))
-
+ (return (build-derivations remote inputs))
(return (close-connection remote))
(return (%remote-eval lowered session become-command)))))))
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)