From aa4c7784940581b5e271b9c7c4ac80b6ee1ee309 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 1 Mar 2018 17:25:14 +0100
Subject: 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'.
---
 bin/evaluate.in | 37 ++++++++++---------------------------
 1 file changed, 10 insertions(+), 27 deletions(-)

(limited to 'bin')

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.~%"
-- 
cgit v1.2.3