From 98a6642298be6663b9d318b7dea46d1dba275839 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 May 2022 00:14:29 +0200 Subject: cuirass: Fork inferior processes before creating threads. Works around . Start from commit bd86bbd300474204878e927f6cd3f0defa1662a5, 'open-inferior' uses 'primitive-fork' instead of 'open-pipe*'. As a result, child process could potentially hang before calling 'execl' due to undefined behavior when forking a multi-threaded process. * build-aux/cuirass/evaluate.scm : Call 'open-inferior' before 'n-par-for-each'. --- build-aux/cuirass/evaluate.scm | 53 +++++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 24 deletions(-) (limited to 'build-aux') diff --git a/build-aux/cuirass/evaluate.scm b/build-aux/cuirass/evaluate.scm index 0bd9e2481f..5beac1b37c 100644 --- a/build-aux/cuirass/evaluate.scm +++ b/build-aux/cuirass/evaluate.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès +;;; Copyright © 2016-2018, 2020, 2022 Ludovic Courtès ;;; Copyright © 2017 Jan Nieuwenhuizen ;;; Copyright © 2021 Mathieu Othacehe ;;; @@ -78,29 +78,34 @@ ;; 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"))) - (close-inferior inferior) - (call-with-output-file file - (lambda (port) - (write jobs port))))))) - %cuirass-supported-systems)))))) + ;; + ;; 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 + (/ (current-processor-count) 2) + (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))) -- cgit 1.4.1