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 943577b evaluation: Build the cached profile only once. 943577b is described below commit 943577bd90613982ea016e55ae253831c53fb0f2 Author: Mathieu Othacehe <othac...@gnu.org> AuthorDate: Fri Mar 5 13:01:22 2021 +0100 evaluation: Build the cached profile only once. * bin/evaluate.in (inferior-evaluation): Move profile building to ... (main): ... here. --- bin/evaluate.in | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/bin/evaluate.in b/bin/evaluate.in index aa87ddc..0e38703 100644 --- a/bin/evaluate.in +++ b/bin/evaluate.in @@ -48,9 +48,10 @@ CHECKOUTS." #:commit commit))) checkouts)) -(define* (inferior-evaluation store instances +(define* (inferior-evaluation store profile #:key - eval-id spec build systems) + eval-id channels + spec build systems) "Spawn an inferior on INSTANCES that uses the given STORE. Withing that inferior, call PROC with PROC-ARGS arguments from MODULE. Pass PROC a register procedure that writes its arguments on a socket. Listen that socket @@ -61,9 +62,7 @@ for new jobs and register them using REGISTER-JOB procedure." ;; The Guix procedure for job evaluation. (define eval-proc 'cuirass-jobs) - (let* ((cached (cached-channel-instance store instances)) - (inferior (open-inferior cached)) - (channels (map channel-instance->sexp instances)) + (let* ((inferior (open-inferior profile)) (args `((channels . ,channels) (systems . ,systems) (subset . ,build)))) @@ -75,6 +74,13 @@ for new jobs and register them using REGISTER-JOB procedure." (,eval-proc store ',args))))) (db-register-builds jobs eval-id spec)))) +(define (instances->cached-profile* instances) + (with-store store + (set-build-options store + #:use-substitutes? #f + #:substitute-urls '()) + (instances->cached-profile store instances))) + (define* (main #:optional (args (command-line))) "This procedure spawns an inferior on the given channels. An evaluation procedure is called within that inferior. The evaluation procedure is passed @@ -92,18 +98,20 @@ nd registered in database." (build (specification-build spec)) (systems (specification-systems spec))) - (par-for-each - (lambda (system) - (with-store store - (set-build-options store - #:use-substitutes? #f - #:substitute-urls '()) - (inferior-evaluation store instances - #:eval-id eval-id - #:spec spec - #:build build - #:systems (list system)))) - systems) + (let ((profile + (instances->cached-profile* instances)) + (channels + (map channel-instance->sexp instances))) + (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)) (display 'done))))) (x (format (current-error-port) "Wrong command: ~a~%." x)