[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
14/14: Cleanup some with-time-logging
|
From: |
Christopher Baines |
|
Subject: |
14/14: Cleanup some with-time-logging |
|
Date: |
Fri, 2 Feb 2024 10:58:40 -0500 (EST) |
cbaines pushed a commit to branch master
in repository data-service.
commit ac1a4cb1e28896631b8774a7b607f4f0bd6dc3c2
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Feb 2 16:58:06 2024 +0100
Cleanup some with-time-logging
---
guix-data-service/jobs/load-new-guix-revision.scm | 98 ++++++++++++-----------
1 file 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)
- branch master updated (e0a6c84 -> ac1a4cb), Christopher Baines, 2024/02/02
- 01/14: Remove some time logging, Christopher Baines, 2024/02/02
- 04/14: Remove even more time logging, Christopher Baines, 2024/02/02
- 02/14: Log the time to call inferior-packages-plus-replacements, Christopher Baines, 2024/02/02
- 05/14: Make sure to keep roots for channel instance derivations, Christopher Baines, 2024/02/02
- 07/14: Add more logging in when computing channel instance derivations, Christopher Baines, 2024/02/02
- 09/14: Split up handling of package description data, Christopher Baines, 2024/02/02
- 10/14: Fix exception handling in call-with-temporary-thread, Christopher Baines, 2024/02/02
- 12/14: Speed up loading package metadata, Christopher Baines, 2024/02/02
- 14/14: Cleanup some with-time-logging,
Christopher Baines <=
- 06/14: Add some time logging in to inferior-packages-plus-replacements, Christopher Baines, 2024/02/02
- 11/14: Ignore inferior-protocol-error when computing channel instances, Christopher Baines, 2024/02/02
- 13/14: Compute lint warnings in parallel, Christopher Baines, 2024/02/02
- 08/14: Speed up fetching package replacements, Christopher Baines, 2024/02/02
- 03/14: Improve logging when computing a channel instance derivation fails, Christopher Baines, 2024/02/02