me/guix
Archived
1
0
Fork 0
Code Activity

hydra: evaluate: Use 'with-build-handler'.

Browse source 
* build-aux/hydra/evaluate.scm (command-line): Remove 'set!' for
'build-things'.  Use 'with-build-handler' instead.
* build-aux/hydra/gnu-system.scm (hydra-jobs): Add comment about
removing 'show-what-to-build' call.
This commit is contained in:
Ludovic Courtès 2020-03-22 12:41:28 +01:00
parent 91601790d0
commit 66a198c807
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 38 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
build-aux/hydra/evaluate.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -24,6 +24,7 @@
(use-modules (guix store) (use-modules (guix store)
(guix git-download) (guix git-download)
((guix build utils) #:select (with-directory-excursion)) ((guix build utils) #:select (with-directory-excursion))
((guix ui) #:select (build-notifier))
(srfi srfi-19) (srfi srfi-19)
(ice-9 match) (ice-9 match)
(ice-9 pretty-print) (ice-9 pretty-print)
@ -89,49 +90,42 @@ Otherwise return THING."
#:use-substitutes? #f #:use-substitutes? #f
#:substitute-urls '()) #:substitute-urls '())
;; Grafts can trigger early builds. We do not want that to happen ;; The evaluation of Guix itself requires building a "trampoline"
;; during evaluation, so use a sledgehammer to catch such problems. ;; program, and possibly everything it depends on. Thus, allow builds
;; An exception, though, is the evaluation of Guix itself, which ;; but print a notification.
;; requires building a "trampoline" program. (with-build-handler (build-notifier #:use-substitutes? #f)
(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)))
;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work ;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
;; from a clean checkout ;; from a clean checkout
(let ((source (add-to-store store "guix-source" #t (let ((source (add-to-store store "guix-source" #t
"sha256" %top-srcdir "sha256" %top-srcdir
#:select? (git-predicate %top-srcdir)))) #:select? (git-predicate %top-srcdir))))
(with-directory-excursion source (with-directory-excursion source
(save-module-excursion (save-module-excursion
(lambda () (lambda ()
(set-current-module %user-module) (set-current-module %user-module)
(format (current-error-port) (format (current-error-port)
"loading '~a' relative to '~a'...~%" "loading '~a' relative to '~a'...~%"
file source) file source)
(primitive-load file)))) (primitive-load file))))
;; Call the entry point of FILE and print the resulting job sexp. ;; Call the entry point of FILE and print the resulting job sexp.
(pretty-print (pretty-print
(match ((module-ref %user-module (match ((module-ref %user-module
(if (equal? cuirass? "cuirass") (if (equal? cuirass? "cuirass")
'cuirass-jobs 'cuirass-jobs
'hydra-jobs)) 'hydra-jobs))
store `((guix store `((guix
. ((file-name . ,source))))) . ((file-name . ,source)))))
(((names . thunks) ...) (((names . thunks) ...)
(map (lambda (job thunk) (map (lambda (job thunk)
(format (current-error-port) "evaluating '~a'... " job) (format (current-error-port) "evaluating '~a'... " job)
(force-output (current-error-port)) (force-output (current-error-port))
(cons job (cons job
(assert-valid-job job (assert-valid-job job
(call-with-time-display thunk)))) (call-with-time-display thunk))))
names thunks))) names thunks)))
port))))) port))))))
((command _ ...) ((command _ ...)
(format (current-error-port) "Usage: ~a FILE [cuirass] (format (current-error-port) "Usage: ~a FILE [cuirass]
Evaluate the Hydra or Cuirass jobs defined in FILE.~%" Evaluate the Hydra or Cuirass jobs defined in FILE.~%"

2
build-aux/hydra/gnu-system.scm
View file

@ -65,6 +65,8 @@ Return #f if no such checkout is found."
(run-with-store store (run-with-store store
(channel-instances->derivation (list instance)))) (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)) (show-what-to-build store (list derivation))
(build-derivations store (list derivation)) (build-derivations store (list derivation))