diff options
Diffstat (limited to 'build-aux/cuirass')
| -rw-r--r-- | build-aux/cuirass/evaluate.scm | 105 | ||||
| -rw-r--r-- | build-aux/cuirass/gnu-system.scm | 25 | ||||
| -rw-r--r-- | build-aux/cuirass/guix-modular.scm | 6 | ||||
| -rw-r--r-- | build-aux/cuirass/hydra-to-cuirass.scm | 47 |
4 files changed, 105 insertions, 78 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))) diff --git a/build-aux/cuirass/gnu-system.scm b/build-aux/cuirass/gnu-system.scm deleted file mode 100644 index 0eb834cfba..0000000000 --- a/build-aux/cuirass/gnu-system.scm +++ /dev/null @@ -1,25 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@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 file defines build jobs for the Cuirass continuation integration -;;; tool. -;;; - -(include "../hydra/gnu-system.scm") -(include "hydra-to-cuirass.scm") diff --git a/build-aux/cuirass/guix-modular.scm b/build-aux/cuirass/guix-modular.scm deleted file mode 100644 index cbbdbf1133..0000000000 --- a/build-aux/cuirass/guix-modular.scm +++ /dev/null @@ -1,6 +0,0 @@ -;;; -;;; This file defines Cuirass build jobs to build Guix itself. -;;; - -(include "../hydra/guix-modular.scm") -(include "hydra-to-cuirass.scm") diff --git a/build-aux/cuirass/hydra-to-cuirass.scm b/build-aux/cuirass/hydra-to-cuirass.scm deleted file mode 100644 index 75c77ea35a..0000000000 --- a/build-aux/cuirass/hydra-to-cuirass.scm +++ /dev/null @@ -1,47 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@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 file defines the conversion of Hydra build jobs to Cuirass build -;;; jobs. It is meant to be included in other files. -;;; - -(use-modules ((guix licenses) - #:select (license? license-name license-uri license-comment))) - -(define (cuirass-jobs store arguments) - "Return Cuirass jobs." - (map hydra-job->cuirass-job (hydra-jobs store arguments))) - -(define (hydra-job->cuirass-job hydra-job) - (let ((name (car hydra-job)) - (job ((cdr hydra-job)))) - (lambda _ (acons #:job-name (symbol->string name) - (map symbol-alist-entry->keyword-alist-entry job))))) - -(define (symbol-alist-entry->keyword-alist-entry entry) - (cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry)))) - -(define (entry->sexp-entry o) - (match o - ((? license?) `((name . (license-name o)) - (uri . ,(license-uri o)) - (comment . ,(license-comment o)))) - ((lst ...) - (map entry->sexp-entry lst)) - (_ o))) |