aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
Diffstat (limited to 'guix-data-service')
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm98
1 files changed, 52 insertions, 46 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 1b47ea6..2737636 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -598,12 +598,10 @@
;; with these that take up lots of memory
(inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf)
- (with-time-logging
- (simple-format #f "getting derivations for ~A" (cons system target))
- (inferior-eval-with-store/non-blocking
- inf
- store
- proc)))
+ (inferior-eval-with-store/non-blocking
+ inf
+ store
+ proc))
(define (sort-and-deduplicate-inferior-packages packages
pkg-to-replacement-hash-table)
@@ -1455,40 +1453,49 @@
(cons
inferior-lint-checkers-data
(and inferior-lint-checkers-data
- (with-time-logging "fetching inferior lint warnings"
- (par-map&
- (match-lambda
- ((checker-name _ network-dependent?)
- (and (and (not network-dependent?)
- ;; Running the derivation linter is
- ;; currently infeasible
- (not (eq? checker-name 'derivation)))
- (with-resource-from-pool inf-and-store-pool res
- (match res
- ((inferior . inferior-store)
- (inferior-lint-warnings inferior
- inferior-store
- checker-name)))))))
- inferior-lint-checkers-data))))))
+ (par-map&
+ (match-lambda
+ ((checker-name _ network-dependent?)
+ (and (and (not network-dependent?)
+ ;; Running the derivation linter is
+ ;; currently infeasible
+ (not (eq? checker-name 'derivation)))
+ (with-resource-from-pool inf-and-store-pool res
+ (match res
+ ((inferior . inferior-store)
+ (inferior-lint-warnings inferior
+ inferior-store
+ checker-name)))))))
+ inferior-lint-checkers-data)))))
(inferior-packages-system-and-target-to-derivations-alist
- (with-time-logging "getting inferior derivations"
- (par-map&
- (match-lambda
- ((system . target)
- (with-resource-from-pool inf-and-store-pool res
+ (par-map&
+ (match-lambda
+ ((system . target)
+ (with-resource-from-pool inf-and-store-pool res
+ (with-time-logging
+ (simple-format #f "getting derivations for ~A" (cons system target))
(match res
((inferior . inferior-store)
(ensure-gds-inferior-packages-defined! inferior)
- (cons (cons system target)
- (inferior-package-derivations inferior-store
- inferior
- system
- target)))))))
- (with-resource-from-pool inf-and-store-pool res
- (match res
- ((inferior . inferior-store)
- (inferior-fetch-system-target-pairs inferior)))))))
+ (let ((drvs
+ (inferior-package-derivations
+ inferior-store
+ inferior
+ system
+ target)))
+
+ (vector-for-each
+ (lambda (_ drv)
+ (and=> drv add-temp-root/long-running-store))
+ drvs)
+
+ (cons (cons system target)
+ drvs))))))))
+ (with-resource-from-pool inf-and-store-pool res
+ (match res
+ ((inferior . inferior-store)
+ (inferior-fetch-system-target-pairs inferior))))))
(inferior-system-tests
(if skip-system-tests?
(begin
@@ -1502,17 +1509,16 @@
guix-source commit
add-temp-root/long-running-store)))))))
(packages-data
- (with-time-logging "getting all inferior package data"
- (with-resource-from-pool inf-and-store-pool res
- (match res
- ((inferior . inferior-store)
- (with-time-logging "fetching inferior packages"
- (let ((packages
- pkg-to-replacement-hash-table
- (inferior-packages-plus-replacements inferior)))
- (all-inferior-packages-data inferior
- packages
- pkg-to-replacement-hash-table)))))))))
+ (with-resource-from-pool inf-and-store-pool res
+ (match res
+ ((inferior . inferior-store)
+ (with-time-logging "getting all inferior package data"
+ (let ((packages
+ pkg-to-replacement-hash-table
+ (inferior-packages-plus-replacements inferior)))
+ (all-inferior-packages-data inferior
+ packages
+ pkg-to-replacement-hash-table))))))))
(destroy-resource-pool inf-and-store-pool)