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

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

@ -1,5 +1,5 @@
;;; 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 © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
@ -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)))