[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Ludovic Courtès |
Date: |
Thu, 1 Mar 2018 11:31:45 -0500 (EST) |
branch: master
commit aa4c7784940581b5e271b9c7c4ac80b6ee1ee309
Author: Ludovic Courtès <address@hidden>
Date: Thu Mar 1 17:25:14 2018 +0100
base: Move database update from 'evaluate' process to the main process.
Fixes <https://bugs.gnu.org/30618>.
Reported by Andreas Enge <address@hidden>.
* 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'.
---
bin/evaluate.in | 37 ++++++++++---------------------------
src/cuirass/base.scm | 41 +++++++++++++++++++++++++++++------------
2 files changed, 39 insertions(+), 39 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:address@hidden@} --no-auto-compile -e main -s "$0" "$@"
!#
;;;; evaluate -- convert a specification to a job list
-;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016, 2018 Ludovic Courtès <address@hidden>
;;; Copyright © 2016, 2017 Mathieu Lirzin <address@hidden>
;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
;;;
@@ -33,19 +33,9 @@ exec ${GUILE:address@hidden@} --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:address@hidden@} --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.~%"
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 8c6cd8c..89f84e9 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -219,6 +219,14 @@ fibers."
(define (evaluate store db spec)
"Evaluate and build package derivations. Return a list of jobs."
+ (define (augment-job job eval-id)
+ (let ((drv (read-derivation-from-file
+ (assq-ref job #:derivation))))
+ `((#:eval-id . ,eval-id)
+ (#:nix-name . ,(derivation-name drv))
+ (#:system . ,(derivation-system drv))
+ ,@job)))
+
(let* ((port (non-blocking-port
(open-pipe* OPEN_READ
"evaluate"
@@ -227,19 +235,28 @@ fibers."
(assq-ref spec #:load-path))
(%guix-package-path)
(%package-cachedir)
- (object->string spec)
- (%package-database))))
- (jobs (match (read/non-blocking port)
- ;; If an error occured during evaluation report it,
- ;; otherwise, suppose that data read from port are
- ;; correct and keep things going.
- ((? eof-object?)
- (raise (condition
- (&evaluation-error
- (name (assq-ref spec #:name))))))
- (data data))))
+ (object->string spec))))
+ (result (match (read/non-blocking port)
+ ;; If an error occured during evaluation report it,
+ ;; otherwise, suppose that data read from port are
+ ;; correct and keep things going.
+ ((? eof-object?)
+ (raise (condition
+ (&evaluation-error
+ (name (assq-ref spec #:name))))))
+ (data data))))
(close-pipe port)
- jobs))
+ (match result
+ (('evaluation eval jobs)
+ (let ((eval-id (db-add-evaluation db eval)))
+ (log-message "created evaluation ~a for ~a, commit ~a" eval-id
+ (assq-ref eval #:specification)
+ (assq-ref eval #:revision))
+ (let ((jobs (map (lambda (job)
+ (augment-job job eval-id))
+ jobs)))
+ (for-each (cut db-add-derivation db <>) jobs)
+ jobs))))))
;;;
- master updated (f5a15ca -> aa4c778), Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject], Ludovic Courtès, 2018/03/01
- [no subject],
Ludovic Courtès <=
- [no subject], Ludovic Courtès, 2018/03/01