01/13: store: 'map/accumulate-builds' preserves caches.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 1ae0e1dc29109cef20dbe9d26eb1c855694716b5
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon May 30 15:58:05 2022 +0200

    store: 'map/accumulate-builds' preserves caches.
    
    Fixes <https://issues.guix.gnu.org/55721>.
    
    Starting from the switch to functional object caches ca.
    9e5812ac59b01ff011ec0c5b0f437dfe85d6fcc7, we would be losing accumulated
    caches when aborting to the build handler.  This patch fixes that.
    
    In particular, by preserving '%reference-cache-id', we avoid redundant
    'query-references' RPCs, which accounted for a large part of the extra
    processing time.
    
    * guix/store.scm (build-accumulator): When returning an <unresolved>
    node, call 'set-store-connection-caches!' before and after to preserve
    caches.
    (map/accumulate-builds): Pass STORE as the first argument to
    the <unresolved> continuation.
---
 guix/store.scm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index efba07bdcd..6bdd071b48 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1337,7 +1337,17 @@ object, only for build requests on EXPECTED-STORE."
     (if (and (eq? (store-connection-socket store)
                   (store-connection-socket expected-store))
              (= mode (build-mode normal)))
-        (unresolved things continue)
+        (begin
+          ;; Preserve caches accumulated up to this handler invocation.
+          (set-store-connection-caches! expected-store
+                                        (store-connection-caches store))
+
+          (unresolved things
+                      (lambda (new-store value)
+                        ;; Borrow caches from NEW-STORE.
+                        (set-store-connection-caches!
+                         store (store-connection-caches new-store))
+                        (continue value))))
         (continue #t))))
 
 (define default-cutoff
@@ -1397,7 +1407,8 @@ CUTOFF is the threshold above which we stop accumulating 
unresolved nodes."
                                       (if (unresolved? obj)
                                           ;; Pass #f because 'build-things' is 
now
                                           ;; unnecessary.
-                                          ((unresolved-continuation obj) #f)
+                                          ((unresolved-continuation obj)
+                                           store #f)
                                           obj))
                                     result #:cutoff cutoff)
          (map/accumulate-builds store proc rest #:cutoff cutoff)))))