mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-06 13:10:33 +02:00
331cfd6277
These lines date back to 89cbec89a5, which was
used for Hydra. Nowadays ‘evaluate.scm’ is only used for debugging purposes
(Cuirass does not use it) so disabling substitutes makes no sense.
* build-aux/cuirass/evaluate.scm <top level>: Remove call to ‘set-build-options’.
Change-Id: I8dbf7098a8b9699509df6f74b9f1dac780db12c1
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
108 lines
4.5 KiB
Scheme
108 lines
4.5 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2016-2018, 2020, 2022 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
|
|
;; 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.
|
|
;;
|
|
;; Fork inferior processes upfront before we have created any
|
|
;; threads.
|
|
(let ((inferiors (map (lambda _
|
|
(open-inferior (derivation->output-path derivation)))
|
|
%cuirass-supported-systems)))
|
|
(n-par-for-each
|
|
(min (length %cuirass-supported-systems)
|
|
(current-processor-count))
|
|
(lambda (system inferior)
|
|
(with-store store
|
|
(let ((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")))
|
|
(close-inferior inferior)
|
|
(call-with-output-file file
|
|
(lambda (port)
|
|
(write jobs port)))))))
|
|
%cuirass-supported-systems
|
|
inferiors)))))))
|
|
(x
|
|
(format (current-error-port) "Wrong command: ~a~%." x)
|
|
(exit 1)))
|