[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Fix evaluation.
From: |
Mathieu Othacehe |
Subject: |
branch master updated: Fix evaluation. |
Date: |
Wed, 10 Mar 2021 10:00:49 -0500 |
This is an automated email from the git hooks/post-receive script.
mothacehe pushed a commit to branch master
in repository guix-cuirass.
The following commit(s) were added to refs/heads/master by this push:
new 94a7f87 Fix evaluation.
94a7f87 is described below
commit 94a7f870a7d813326e6ac6539d243a2994eca918
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Mar 10 16:00:33 2021 +0100
Fix evaluation.
* bin/evaluate.in: Fix it.
---
bin/evaluate.in | 55 +++++++++++++++++++++++++++++++++----------------------
1 file changed, 33 insertions(+), 22 deletions(-)
diff --git a/bin/evaluate.in b/bin/evaluate.in
index ba4a4dd..4569581 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -37,9 +37,21 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(ice-9 pretty-print)
(ice-9 threads))
+(define (checkouts->channel-instances checkouts)
+ "Return the list of CHANNEL-INSTANCE records describing the given
+CHECKOUTS."
+ (map (lambda (checkout)
+ (let ((channel (assq-ref checkout #:channel))
+ (directory (assq-ref checkout #:directory))
+ (commit (assq-ref checkout #:commit)))
+ (checkout->channel-instance directory
+ #:name channel
+ #:commit commit)))
+ checkouts))
+
(define* (inferior-evaluation store profile
#:key
- eval-id channels
+ eval-id instances
spec build systems)
"Spawn an inferior that uses the given STORE and PROFILE. Withing that
inferior, call EVAL-PROC from the EVAL-MODULE. Register the returned jobs in
@@ -52,11 +64,11 @@ Pass the BUILD, CHANNELS and SYSTEMS arguments to the
EVAL-PROC procedure."
;; The Guix procedure for job evaluation.
(define eval-proc 'cuirass-jobs)
- (define channels*
- (map channel->sexp channels))
+ (define channels
+ (map channel-instance->sexp instances))
(let* ((inferior (open-inferior profile))
- (args `((channels . ,channels*)
+ (args `((channels . ,channels)
(systems . ,systems)
(subset . ,build))))
(inferior-eval `(use-modules ,eval-module) inferior)
@@ -101,27 +113,26 @@ registered in database."
(name (db-get-evaluation-specification eval-id))
(spec (db-get-specification name))
(checkouts (db-get-checkouts eval-id))
+ (instances (checkouts->channel-instances checkouts))
+ (channels (specification-channels spec))
+ (profile (channels->cached-profile channels checkouts))
(build (specification-build spec))
(systems (specification-systems spec)))
- (let* ((channels
- (specification-channels spec))
- (profile
- (channels->cached-profile channels checkouts)))
- ;; Evaluate jobs on a per-system basis for two reasons. It
- ;; speeds up the evaluation speed as the evaluations can be
- ;; performed concurrently. It also decreases the amount of
- ;; memory needed per evaluation process.
- (par-for-each
- (lambda (system)
- (with-store store
- (inferior-evaluation store profile
- #:eval-id eval-id
- #:channels channels
- #:spec spec
- #:build build
- #:systems (list system))))
- systems))
+ ;; Evaluate jobs on a per-system basis for two reasons. It
+ ;; speeds up the evaluation speed as the evaluations can be
+ ;; performed concurrently. It also decreases the amount of
+ ;; memory needed per evaluation process.
+ (par-for-each
+ (lambda (system)
+ (with-store store
+ (inferior-evaluation store profile
+ #:eval-id eval-id
+ #:instances instances
+ #:spec spec
+ #:build build
+ #:systems (list system))))
+ systems)
(display 'done)))))
(x
(format (current-error-port) "Wrong command: ~a~%." x)
- branch master updated: Fix evaluation.,
Mathieu Othacehe <=