diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-11-26 17:17:45 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-06 21:41:07 +0100 |
commit | b5f8c2c88543158e8aca76aa98f9009f6b9e743a (patch) | |
tree | 5ef8083a9449e5de8d96dea369ade6c2b3137e88 /build-aux/hydra | |
parent | 65ff85dcee76179f064aa533c6ca8de77a4ebe9a (diff) | |
download | guix-b5f8c2c88543158e8aca76aa98f9009f6b9e743a.tar.gz |
hydra: Compute jobs in an inferior.
Previously we would rely on auto-compilation of all the Guix modules. The complete evaluation would take ~15mn on berlin.guixsd.org and require lots of RAM. This approach should be faster since potentially only part of the modules are rebuilt. Furthermore, as a side-effect, it builds the derivations that 'guix pull' uses. * build-aux/hydra/gnu-system.scm: Remove 'eval-when' form. (hydra-jobs): New procedure. * gnu/ci.scm (package->alist, qemu-jobs, system-test-jobs) (tarball-jobs): Return strings for the 'license' field. * guix/self.scm (compiled-guix)[*cli-modules*]: Add (gnu ci).
Diffstat (limited to 'build-aux/hydra')
-rw-r--r-- | build-aux/hydra/gnu-system.scm | 73 |
1 files changed, 45 insertions, 28 deletions
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 150c2bdf4f..775bbd9db2 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -23,39 +23,56 @@ ;;; tool. ;;; -(use-modules (system base compile)) +(use-modules (guix inferior) (guix channels) + (guix) + (guix ui) + (srfi srfi-1) + (ice-9 match)) -(eval-when (expand load eval) +;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output +;; port to the bit bucket, let us write to the error port instead. +(setvbuf (current-error-port) _IOLBF) +(set-current-output-port (current-error-port)) - ;; Pre-load the compiler so we don't end up auto-compiling it. - (compile #t) +(define (hydra-jobs store arguments) + "Return a list of jobs where each job is a NAME/THUNK pair." + (define checkout + ;; Extract metadata about the 'guix' checkout. Its key in ARGUMENTS may + ;; vary, so pick up the first one that's neither 'subset' nor 'systems'. + (any (match-lambda + ((key . value) + (and (not (memq key '(systems subset))) + value))) + arguments)) - ;; Use our very own Guix modules. - (set! %fresh-auto-compile #t) + (define commit + (assq-ref checkout 'revision)) - ;; Ignore .go files except for Guile's. This is because our checkout in the - ;; store has mtime set to the epoch, and thus .go files look newer, even - ;; though they may not correspond. Use 'reverse' so that /gnu/store/…-guile - ;; comes before /run/current-system/profile. - (set! %load-compiled-path - (list - (dirname (dirname (search-path (reverse %load-compiled-path) - "ice-9/boot-9.go"))))) + (define source + (assq-ref checkout 'file-name)) - (and=> (assoc-ref (current-source-location) 'filename) - (lambda (file) - (let ((dir (canonicalize-path - (string-append (dirname file) "/../..")))) - (format (current-error-port) "prepending ~s to the load path~%" - dir) - (set! %load-path (cons dir %load-path)))))) + (define instance + (checkout->channel-instance source #:commit commit)) -(use-modules (gnu ci)) + (define derivation + ;; Compute the derivation of Guix for COMMIT. + (run-with-store store + (channel-instances->derivation (list instance)))) -;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output -;; port to the bit bucket, let us write to the error port instead. -(setvbuf (current-error-port) _IOLBF) -(set-current-output-port (current-error-port)) + (show-what-to-build store (list derivation)) + (build-derivations store (list derivation)) + + ;; Open an inferior for the just-built Guix. + (let ((inferior (open-inferior (derivation->output-path derivation)))) + (inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior) -;; Return the procedure from (gnu ci). -hydra-jobs + (map (match-lambda + ((name . fields) + ;; Hydra expects a thunk, so here it is. + (cons name (lambda () fields)))) + (inferior-eval-with-store inferior store + `(lambda (store) + (map (match-lambda + ((name . thunk) + (cons name (thunk)))) + (hydra-jobs store ',arguments))))))) |