TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

cuirass: Fork inferior processes before creating threads. 

Works around <https://issues.guix.gnu.org/55441#12>.

Start from commit bd86bbd300,
'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 <top level>: Call 'open-inferior'
before 'n-par-for-each'.
This commit is contained in:
Ludovic Courtès 2022-05-26 00:14:29 +02:00
parent dcb7ce1eb6
commit 98a6642298
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
build-aux/cuirass/evaluate.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org> ;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;; ;;;
@ -78,13 +78,17 @@
;; up the evaluation speed as the evaluations can be performed ;; up the evaluation speed as the evaluations can be performed
;; concurrently. It also decreases the amount of memory needed per ;; concurrently. It also decreases the amount of memory needed per
;; evaluation process. ;; 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 (n-par-for-each
(/ (current-processor-count) 2) (/ (current-processor-count) 2)
(lambda (system) (lambda (system inferior)
(with-store store (with-store store
(let ((inferior (let ((channels (map channel-instance->sexp instances)))
(open-inferior (derivation->output-path derivation)))
(channels (map channel-instance->sexp instances)))
(inferior-eval '(use-modules (gnu ci)) inferior) (inferior-eval '(use-modules (gnu ci)) inferior)
(let ((jobs (let ((jobs
(inferior-eval-with-store (inferior-eval-with-store
@ -100,7 +104,8 @@
(call-with-output-file file (call-with-output-file file
(lambda (port) (lambda (port)
(write jobs port))))))) (write jobs port)))))))
%cuirass-supported-systems)))))) %cuirass-supported-systems
inferiors)))))))
(x (x
(format (current-error-port) "Wrong command: ~a~%." x) (format (current-error-port) "Wrong command: ~a~%." x)
(exit 1))) (exit 1)))