summary refs log tree commit diff
path: root/build-aux
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-03-27 00:12:15 +0100
committerMarius Bakke <mbakke@fastmail.com>2020-03-27 00:12:15 +0100
commit18af6870370226b4d502d7372844e7f2aded5887 (patch)
tree749d93209bd0cb9710ccaae2207df670f37eaa36 /build-aux
parent0ab8ad46322bea331ed5f5592843ba35e7f38b37 (diff)
parent3089b70d766bd9ec70e1464867130b7b864fbe17 (diff)
downloadguix-18af6870370226b4d502d7372844e7f2aded5887.tar.gz
Merge branch 'master' into core-updates
 Conflicts:
	gnu/packages/icu4c.scm
	gnu/packages/man.scm
	gnu/packages/python-xyz.scm
	guix/scripts/environment.scm
	guix/scripts/pack.scm
	guix/scripts/package.scm
	guix/scripts/pull.scm
	guix/store.scm
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/hydra/evaluate.scm85
-rw-r--r--build-aux/hydra/gnu-system.scm2
2 files changed, 38 insertions, 49 deletions
diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm
index adb14808fa..c74fcdb763 100644
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/hydra/evaluate.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -24,6 +24,7 @@
 (use-modules (guix store)
              (guix git-download)
              ((guix build utils) #:select (with-directory-excursion))
+             ((guix ui) #:select (build-notifier))
              (srfi srfi-19)
              (ice-9 match)
              (ice-9 pretty-print)
@@ -41,13 +42,6 @@
     (beautify-user-module! m)
     m))
 
-(cond-expand
-  (guile-2.2
-   ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
-   ;; nanoseconds swapped (fixed in Guile commit 886ac3e).  Work around it.
-   (define time-monotonic time-tai))
-  (else #t))
-
 (define (call-with-time thunk kont)
   "Call THUNK and pass KONT the elapsed time followed by THUNK's return
 values."
@@ -89,49 +83,42 @@ Otherwise return THING."
                           #:use-substitutes? #f
                           #:substitute-urls '())
 
-       ;; Grafts can trigger early builds.  We do not want that to happen
-       ;; during evaluation, so use a sledgehammer to catch such problems.
-       ;; An exception, though, is the evaluation of Guix itself, which
-       ;; requires building a "trampoline" program.
-       (set! build-things
-         (lambda (store . args)
-           (format (current-error-port)
-                   "warning: building things during evaluation~%")
-           (format (current-error-port)
-                   "'build-things' arguments: ~s~%" args)
-           (apply real-build-things store args)))
+       ;; The evaluation of Guix itself requires building a "trampoline"
+       ;; program, and possibly everything it depends on.  Thus, allow builds
+       ;; but print a notification.
+       (with-build-handler (build-notifier #:use-substitutes? #f)
 
-       ;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
-       ;; from a clean checkout
-       (let ((source (add-to-store store "guix-source" #t
-                                   "sha256" %top-srcdir
-                                   #:select? (git-predicate %top-srcdir))))
-         (with-directory-excursion source
-           (save-module-excursion
-            (lambda ()
-              (set-current-module %user-module)
-              (format (current-error-port)
-                      "loading '~a' relative to '~a'...~%"
-                      file source)
-              (primitive-load file))))
+         ;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
+         ;; from a clean checkout
+         (let ((source (add-to-store store "guix-source" #t
+                                     "sha256" %top-srcdir
+                                     #:select? (git-predicate %top-srcdir))))
+           (with-directory-excursion source
+             (save-module-excursion
+              (lambda ()
+                (set-current-module %user-module)
+                (format (current-error-port)
+                        "loading '~a' relative to '~a'...~%"
+                        file source)
+                (primitive-load file))))
 
-         ;; Call the entry point of FILE and print the resulting job sexp.
-         (pretty-print
-          (match ((module-ref %user-module
-                              (if (equal? cuirass? "cuirass")
-                                  'cuirass-jobs
-                                  'hydra-jobs))
-                  store `((guix
-                           . ((file-name . ,source)))))
-            (((names . thunks) ...)
-             (map (lambda (job thunk)
-                    (format (current-error-port) "evaluating '~a'... " job)
-                    (force-output (current-error-port))
-                    (cons job
-                          (assert-valid-job job
-                                            (call-with-time-display thunk))))
-                  names thunks)))
-          port)))))
+           ;; Call the entry point of FILE and print the resulting job sexp.
+           (pretty-print
+            (match ((module-ref %user-module
+                                (if (equal? cuirass? "cuirass")
+                                    'cuirass-jobs
+                                    'hydra-jobs))
+                    store `((guix
+                             . ((file-name . ,source)))))
+              (((names . thunks) ...)
+               (map (lambda (job thunk)
+                      (format (current-error-port) "evaluating '~a'... " job)
+                      (force-output (current-error-port))
+                      (cons job
+                            (assert-valid-job job
+                                              (call-with-time-display thunk))))
+                    names thunks)))
+            port))))))
   ((command _ ...)
    (format (current-error-port) "Usage: ~a FILE [cuirass]
 Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 4afdb48903..a03324daeb 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -65,6 +65,8 @@ Return #f if no such checkout is found."
     (run-with-store store
       (channel-instances->derivation (list instance))))
 
+  ;; TODO: Remove 'show-what-to-build' call when Cuirass' 'evaluate' scripts
+  ;; uses 'with-build-handler'.
   (show-what-to-build store (list derivation))
   (build-derivations store (list derivation))