summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-03-01 17:25:14 +0100
committerLudovic Courtès <ludo@gnu.org>2018-03-01 17:25:14 +0100
commitaa4c7784940581b5e271b9c7c4ac80b6ee1ee309 (patch)
treea6051edc2f5b1e4c34b9a11c0213b8944cbd9ea8 /bin
parentad577114dde4c86455262a35ad4b3838eb4a1453 (diff)
downloadcuirass-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.in37
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.~%"