guix/build-aux/cuirass/evaluate.scm
Mathieu Othacehe 76bea3f8bc
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.
2021-03-10 08:49:48 +01:00

105 lines
4.3 KiB
Scheme

;;; 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)))