From: "Ludovic Courtès" <ludo@gnu.org>
To: 33515@debbugs.gnu.org
Subject: [bug#33515] [PATCH 5/5] hydra: Compute jobs in an inferior.
Date: Mon, 26 Nov 2018 17:45:24 +0100 [thread overview]
Message-ID: <20181126164524.17680-5-ludo@gnu.org> (raw)
In-Reply-To: <20181126164524.17680-1-ludo@gnu.org>
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).
---
build-aux/hydra/gnu-system.scm | 71 ++++++++++++++++++++--------------
gnu/ci.scm | 20 +++++++---
guix/self.scm | 3 +-
3 files changed, 58 insertions(+), 36 deletions(-)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 150c2bdf4f..db91440854 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -23,39 +23,50 @@
;;; tool.
;;;
-(use-modules (system base compile))
-
-(eval-when (expand load eval)
-
- ;; Pre-load the compiler so we don't end up auto-compiling it.
- (compile #t)
-
- ;; Use our very own Guix modules.
- (set! %fresh-auto-compile #t)
-
- ;; 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")))))
-
- (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))))))
-
-(use-modules (gnu ci))
+(use-modules (guix inferior) (guix channels)
+ (guix)
+ (guix ui)
+ (ice-9 match))
;; 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))
-;; Return the procedure from (gnu ci).
-hydra-jobs
+(define (hydra-jobs store arguments)
+ "Return a list of jobs where each job is a NAME/THUNK pair."
+ (define checkout
+ (or (assq-ref arguments 'guix) ;Hydra on hydra
+ (assq-ref arguments 'guix-modular))) ;Cuirass on berlin
+
+ (define commit
+ (assq-ref checkout 'revision))
+
+ (define source
+ (assq-ref checkout 'file-name))
+
+ (define instance
+ (checkout->channel-instance source #:commit commit))
+
+ (define derivation
+ ;; Compute the derivation of Guix for COMMIT.
+ (run-with-store store
+ (channel-instances->derivation (list instance))))
+
+ (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)
+
+ (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)))))))
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 8ece08e453..8daf9e7e35 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -27,7 +27,8 @@
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix ui)
- #:use-module ((guix licenses) #:select (gpl3+))
+ #:use-module ((guix licenses)
+ #:select (gpl3+ license? license-name))
#:use-module ((guix utils) #:select (%current-system))
#:use-module ((guix scripts system) #:select (read-operating-system))
#:use-module ((guix scripts pack)
@@ -69,7 +70,16 @@
#:graft? #f)))
(description . ,(package-synopsis package))
(long-description . ,(package-description package))
- (license . ,(package-license package))
+
+ ;; XXX: Hydra ignores licenses that are not a <license> structure or a
+ ;; list thereof.
+ (license . ,(let loop ((license (package-license package)))
+ (match license
+ ((? license?)
+ (license-name license))
+ ((lst ...)
+ (map loop license)))))
+
(home-page . ,(package-home-page package))
(maintainers . ("bug-guix@gnu.org"))
(max-silent-time . ,(or (assoc-ref (package-properties package)
@@ -133,7 +143,7 @@ SYSTEM."
(description . "Stand-alone QEMU image of the GNU system")
(long-description . "This is a demo stand-alone QEMU image of the GNU
system.")
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org"))))
@@ -192,7 +202,7 @@ system.")
(description . ,(format #f "GuixSD '~a' system test"
(system-test-name test)))
(long-description . ,(system-test-description test))
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org")))))
@@ -213,7 +223,7 @@ system.")
(description . "Stand-alone binary Guix tarball")
(long-description . "This is a tarball containing binaries of Guix and
all its dependencies, and ready to be installed on non-GuixSD distributions.")
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org"))))
diff --git a/guix/self.scm b/guix/self.scm
index 96fef44e78..065705641d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -613,7 +613,8 @@ assumed to be part of MODULES."
(define *cli-modules*
(scheme-node "guix-cli"
- (scheme-modules* source "/guix/scripts")
+ (append (scheme-modules* source "/guix/scripts")
+ `((gnu ci)))
(list *core-modules* *extra-modules*
*core-package-modules* *package-modules*
*system-modules*)
--
2.19.1
next prev parent reply other threads:[~2018-11-26 16:46 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-11-26 16:37 [bug#33515] [PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior Ludovic Courtès
2018-11-26 16:45 ` [bug#33515] [PATCH 1/5] inferior: Add 'inferior-eval-with-store' Ludovic Courtès
2018-11-26 16:45 ` [bug#33515] [PATCH 2/5] hydra: Move job definitions to (gnu ci) Ludovic Courtès
2018-11-26 16:45 ` [bug#33515] [PATCH 3/5] hydra: evaluate: Add the checkout to the store Ludovic Courtès
2018-11-26 16:45 ` [bug#33515] [PATCH 4/5] channels: Add 'checkout->channel-instance' Ludovic Courtès
2018-11-26 16:45 ` Ludovic Courtès [this message]
2018-11-28 9:51 ` [bug#33515] [PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior Ludovic Courtès
2018-12-27 17:27 ` Ludovic Courtès
2018-12-28 4:21 ` Mark H Weaver
2018-12-28 23:19 ` Ludovic Courtès
2019-01-06 20:44 ` bug#33515: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20181126164524.17680-5-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=33515@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.