summaryrefslogtreecommitdiff
path: root/build-aux/cuirass/evaluate.scm
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-03-10 08:48:19 +0100
committerMathieu Othacehe <othacehe@gnu.org>2021-03-10 08:49:48 +0100
commit76bea3f8bcd951ded88dfb7f8cad5bc3e5a1701f (patch)
tree22968402c681697e3fd23e5988d5e79f64a9b1a5 /build-aux/cuirass/evaluate.scm
parent4399b1cf572b1e23ac80a7b7d63daee34a77e104 (diff)
ci: Remove hydra support.
This removes hydra support to use Cuirass as the only continuous integration system. * build-aux/hydra/gnu-system.scm: Remove it. * build-aux/hydra/guix-modular.scm: Ditto. * build-aux/hydra/guix.scm: Ditto. * build-aux/cuirass/hydra-to-cuirass.scm: Ditto. * Makefile.am (EXTRA_DIST): Update it. (hydra-jobs.scm): Remove it. (cuirass-jobs.scm): Update it. * build-aux/hydra/evaluate.scm: Move it to ... * build-aux/cuirass/evaluate.scm: ... here. * build-aux/cuirass/guix-modular.scm: Remove it. * build-aux/cuirass/gnu-system.scm: Ditto. * guix/packages.scm (%hydra-supported-systems): Rename it to ... (%cuirass-supported-systems): ... this variable. * build-aux/check-final-inputs-self-contained: Adapt it. * etc/release-manifest.scm: Ditto. * gnu/ci.scm (package->alist): Remove it. (derivation->job): New procedure. (package-job, package-cross-job, cross-jobs, image-jobs, system-test-jobs, tarball-jobs): Use it. (guix-jobs): New procedure. (hydra-jobs): Rename it to ... (cuirass-jobs): ... this procedure.
Diffstat (limited to 'build-aux/cuirass/evaluate.scm')
-rw-r--r--build-aux/cuirass/evaluate.scm105
1 files changed, 105 insertions, 0 deletions
diff --git a/build-aux/cuirass/evaluate.scm b/build-aux/cuirass/evaluate.scm
new file mode 100644
index 0000000000..fc0744ad2a
--- /dev/null
+++ b/build-aux/cuirass/evaluate.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; This program replicates the behavior of Cuirass's 'evaluate' process.
+;;; It displays the evaluated jobs on the standard output.
+
+(use-modules (guix channels)
+ (guix derivations)
+ (guix git-download)
+ (guix inferior)
+ (guix packages)
+ (guix store)
+ (guix ui)
+ ((guix ui) #:select (build-notifier))
+ (ice-9 match)
+ (ice-9 threads))
+
+(define %top-srcdir
+ (and=> (assq-ref (current-source-location) 'filename)
+ (lambda (file)
+ (canonicalize-path
+ (string-append (dirname file) "/../..")))))
+
+(match (command-line)
+ ((command directory)
+ (let ((real-build-things build-things))
+ (with-store store
+ ;; Make sure we don't resort to substitutes.
+ (set-build-options store
+ #:use-substitutes? #f
+ #:substitute-urls '())
+
+ ;; 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))))
+ (define instances
+ (list (checkout->channel-instance source)))
+
+ (define channels
+ (map channel-instance-channel instances))
+
+ (define derivation
+ ;; Compute the derivation of Guix for COMMIT.
+ (run-with-store store
+ (channel-instances->derivation instances)))
+
+ ;; 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))
+
+
+ ;; Evaluate jobs on a per-system basis for two reasons. It speeds
+ ;; up the evaluation speed as the evaluations can be performed
+ ;; concurrently. It also decreases the amount of memory needed per
+ ;; evaluation process.
+ (n-par-for-each
+ (/ (current-processor-count) 2)
+ (lambda (system)
+ (with-store store
+ (let ((inferior
+ (open-inferior (derivation->output-path derivation)))
+ (channels (map channel-instance->sexp instances)))
+ (inferior-eval '(use-modules (gnu ci)) inferior)
+ (let ((jobs
+ (inferior-eval-with-store
+ inferior store
+ `(lambda (store)
+ (cuirass-jobs store
+ '((subset . all)
+ (systems . ,(list system))
+ (channels . ,channels))))))
+ (file
+ (string-append directory "/jobs-" system ".scm")))
+ (call-with-output-file file
+ (lambda (port)
+ (write jobs port)))))))
+ %cuirass-supported-systems))))))
+ (x
+ (format (current-error-port) "Wrong command: ~a~%." x)
+ (exit 1)))