amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ci: Add extra jobs for tunable packages.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2021-12-04 19:01:14 +01:00
parent d090e9c37d
commit 6756c64a8f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 34 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

43
gnu/ci.scm
View file

@ -28,6 +28,7 @@
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix packages) #:use-module (guix packages)
#:autoload (guix transformations) (tunable-package? tuned-package)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -107,9 +108,9 @@ building the derivation."
(#:timeout . ,timeout))) (#:timeout . ,timeout)))
(define* (package-job store job-name package system (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." "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)) (parameterize ((%graft? #f))
(let* ((drv (if cross? (let* ((drv (if cross?
(package-cross-derivation store package target system (package-cross-derivation store package target system
@ -395,21 +396,39 @@ otherwise use the IMAGE name."
(((_ inputs _ ...) ...) (((_ inputs _ ...) ...)
inputs)))) inputs))))
(%final-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 "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) (cond ((member package base-packages)
(package-job store (string-append "base." (job-name package)) (package-job store (string-append "base." (job-name package))
package system)) package system #:suffix suffix))
((supported-package? package system) ((supported-package? package system)
(let ((drv (package-derivation store package system (let ((drv (package-derivation store package system
#:graft? #f))) #:graft? #f)))
(and (substitutable-derivation? drv) (and (substitutable-derivation? drv)
(package-job store (job-name package) (package-job store (job-name package)
package system)))) package system #:suffix suffix))))
(else (else
#f))))) #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) (define (all-packages)
"Return the list of packages to build." "Return the list of packages to build."
(define (adjust package result) (define (adjust package result)
@ -527,10 +546,16 @@ names."
('all ('all
;; Build everything, including replacements. ;; Build everything, including replacements.
(let ((all (all-packages)) (let ((all (all-packages))
(job (lambda (package) (jobs (lambda (package)
(package->job store package system)))) (match (package->job store package system)
(#f '())
(main-job
(cons main-job
(if (tunable-package? package)
(tuned-package-jobs store package system)
'())))))))
(append (append
(filter-map job all) (append-map jobs all)
(cross-jobs store system)))) (cross-jobs store system))))
('core ('core
;; Build core packages only. ;; Build core packages only.