diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-03-01 17:25:14 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-03-01 17:25:14 +0100 |
commit | aa4c7784940581b5e271b9c7c4ac80b6ee1ee309 (patch) | |
tree | a6051edc2f5b1e4c34b9a11c0213b8944cbd9ea8 /bin | |
parent | ad577114dde4c86455262a35ad4b3838eb4a1453 (diff) | |
download | cuirass-aa4c7784940581b5e271b9c7c4ac80b6ee1ee309.tar cuirass-aa4c7784940581b5e271b9c7c4ac80b6ee1ee309.tar.gz |
base: Move database update from 'evaluate' process to the main process.
Fixes <https://bugs.gnu.org/30618>.
Reported by Andreas Enge <andreas@enge.fr>.
* bin/evaluate.in (fill-job): Remove.
(main): Remove 'database' command-line argument. Remove DB and its
uses. Write an (evaluation EVAL JOBS) sexp.
* src/cuirass/base.scm (evaluate)[augment-job]: New procedure.
Use it. Adjust to read (evaluation EVAL JOBS) sexp. Call
'db-add-evaluation' and 'db-add-derivation'.
Diffstat (limited to 'bin')
-rw-r--r-- | bin/evaluate.in | 37 |
1 files changed, 10 insertions, 27 deletions
diff --git a/bin/evaluate.in b/bin/evaluate.in index 37ba493..a2fa86d 100644 --- a/bin/evaluate.in +++ b/bin/evaluate.in @@ -6,7 +6,7 @@ export GUILE_LOAD_PATH exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" !# ;;;; evaluate -- convert a specification to a job list -;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; @@ -33,19 +33,9 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (guix derivations) (guix store)) -(define (fill-job job eval-id) - "Augment the JOB alist with EVAL-ID and additional information - gathered from JOB’s #:derivation." - (let ((drv (read-derivation-from-file - (assq-ref job #:derivation)))) - `((#:eval-id . ,eval-id) - (#:nix-name . ,(derivation-name drv)) - (#:system . ,(derivation-system drv)) - ,@job))) - (define* (main #:optional (args (command-line))) (match args - ((command load-path guix-package-path cachedir specstr database) + ((command load-path guix-package-path cachedir specstr) ;; Load FILE, a Scheme file that defines Hydra jobs. (let ((%user-module (make-fresh-user-module)) (spec (with-input-from-string specstr read)) @@ -69,30 +59,23 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" stderr) (simple-format stderr "'build-things' arguments: ~S~%" args) (exit 1))) - (parameterize ((%package-database database) - (%use-substitutes? (assoc-ref spec #:use-substitutes?))) + + (parameterize ((%use-substitutes? (assoc-ref spec #:use-substitutes?))) (unless (string-null? guix-package-path) (set-guix-package-path! guix-package-path)) ;; Call the entry point of FILE and print the resulting job sexp. (let* ((proc-name (assq-ref spec #:proc)) (proc (module-ref %user-module proc-name)) (thunks (proc store (assq-ref spec #:arguments))) - (db (db-open)) (commit (assq-ref spec #:current-commit)) (eval `((#:specification . ,(assq-ref spec #:name)) - (#:revision . ,commit))) - (eval-id (db-add-evaluation db eval))) + (#:revision . ,commit)))) (pretty-print - (map (lambda (thunk) - (let* ((job (call-with-time-display thunk)) - ;; Fill job with informations that will later be - ;; added to database. - (job* (fill-job job eval-id))) - (db-add-derivation db job*) - job*)) - thunks) - stdout) - (db-close db)))))) + `(evaluation ,eval + ,(map (lambda (thunk) + (call-with-time-display thunk)) + thunks)) + stdout)))))) ((command _ ...) (simple-format (current-error-port) "Usage: ~A FILE Evaluate the Hydra jobs defined in FILE.~%" |