summaryrefslogtreecommitdiff
path: root/gnu/ci.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-12-04 19:01:14 +0100
committerLudovic Courtès <ludo@gnu.org>2022-01-01 15:23:24 +0100
commit6756c64a8f1a22f74ea3bcb8bfb00f229ad6f6c5 (patch)
treece34ca8754920cde6b9e59c1fc3a48948efd5b1f /gnu/ci.scm
parentd090e9c37d693f5a0f381482c17fb03462cb6a48 (diff)
ci: Add extra jobs for tunable packages.
This allows us to provide substitutes for tuned package variants. * gnu/ci.scm (package-job): Add #:suffix and honor it. (package->job): Add #:suffix and honor it. (%x86-64-micro-architectures): New variable. (tuned-package-jobs): New procedure. (cuirass-jobs): Add jobs for tunable packages.
Diffstat (limited to 'gnu/ci.scm')
-rw-r--r--gnu/ci.scm43
1 files changed, 34 insertions, 9 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 6039af8f07..35fd583f75 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -28,6 +28,7 @@
#:use-module (guix grafts)
#:use-module (guix profiles)
#:use-module (guix packages)
+ #:autoload (guix transformations) (tunable-package? tuned-package)
#:use-module (guix channels)
#:use-module (guix config)
#:use-module (guix derivations)
@@ -107,9 +108,9 @@ building the derivation."
(#:timeout . ,timeout)))
(define* (package-job store job-name package system
- #:key cross? target)
+ #:key cross? target (suffix ""))
"Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
- (let ((job-name (string-append job-name "." system)))
+ (let ((job-name (string-append job-name "." system suffix)))
(parameterize ((%graft? #f))
(let* ((drv (if cross?
(package-cross-derivation store package target system
@@ -395,21 +396,39 @@ otherwise use the IMAGE name."
(((_ inputs _ ...) ...)
inputs))))
(%final-inputs)))))
- (lambda (store package system)
+ (lambda* (store package system #:key (suffix ""))
"Return a job for PACKAGE on SYSTEM, or #f if this combination is not
-valid."
+valid. Append SUFFIX to the job name."
(cond ((member package base-packages)
(package-job store (string-append "base." (job-name package))
- package system))
+ package system #:suffix suffix))
((supported-package? package system)
(let ((drv (package-derivation store package system
#:graft? #f)))
(and (substitutable-derivation? drv)
(package-job store (job-name package)
- package system))))
+ package system #:suffix suffix))))
(else
#f)))))
+(define %x86-64-micro-architectures
+ ;; Micro-architectures for which we build tuned variants.
+ '("westmere" "ivybridge" "haswell" "skylake" "skylake-avx512"))
+
+(define (tuned-package-jobs store package system)
+ "Return a list of jobs for PACKAGE tuned for SYSTEM's micro-architectures."
+ (filter-map (lambda (micro-architecture)
+ (define suffix
+ (string-append "." micro-architecture))
+
+ (package->job store
+ (tuned-package package micro-architecture)
+ system
+ #:suffix suffix))
+ (match system
+ ("x86_64-linux" %x86-64-micro-architectures)
+ (_ '()))))
+
(define (all-packages)
"Return the list of packages to build."
(define (adjust package result)
@@ -527,10 +546,16 @@ names."
('all
;; Build everything, including replacements.
(let ((all (all-packages))
- (job (lambda (package)
- (package->job store package system))))
+ (jobs (lambda (package)
+ (match (package->job store package system)
+ (#f '())
+ (main-job
+ (cons main-job
+ (if (tunable-package? package)
+ (tuned-package-jobs store package system)
+ '())))))))
(append
- (filter-map job all)
+ (append-map jobs all)
(cross-jobs store system))))
('core
;; Build core packages only.