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

hydra: Honor 'package-supported-systems'.

Browse source 
* guix/packages.scm (%supported-systems): New variable.
  (<package>)[platforms]: Rename to...
  [supported-systems]: ... this.  Change default to %SUPPORTED-SYSTEMS.
* build-aux/hydra/gnu-system.scm (job-name, package->job): New
  procedures, formerly in 'hydra-jobs'.  Honor 'package-supported-systems'.
  (hydra-jobs): Use them.
This commit is contained in:
Ludovic Courtès 2014-10-06 19:14:47 +02:00
parent 288dca55a8
commit 4e097f8606
2 changed files with 60 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

88
build-aux/hydra/gnu-system.scm
View file

@ -154,21 +154,41 @@ system.")
(* 630 MiB)))))
'()))
(define job-name
;; Return the name of a package's job.
(compose string->symbol package-full-name))
(define package->job
(let ((base-packages
(delete-duplicates
(append-map (match-lambda
((_ package _ ...)
(match (package-transitive-inputs package)
(((_ inputs _ ...) ...)
inputs))))
%final-inputs))))
(lambda (store package system)
"Return a job for PACKAGE on SYSTEM, or #f if this combination is not
valid."
(cond ((member package base-packages)
#f)
((member system (package-supported-systems package))
(package-job store (job-name package) package system))
(else
#f)))))
;;;
;;; Hydra entry point.
;;;
(define (hydra-jobs store arguments)
"Return Hydra jobs."
(define systems
;; Systems we want to build for.
'("x86_64-linux" "i686-linux"
"mips64el-linux"))
(define subset
(match (assoc-ref arguments 'subset)
("core" 'core) ; only build core packages
(_ 'all))) ; build everything
(define job-name
(compose string->symbol package-full-name))
(define (cross-jobs system)
(define (from-32-to-64? target)
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.
@ -195,33 +215,25 @@ system.")
(remove (either from-32-to-64? same?) %cross-targets)))
;; Return one job for each package, except bootstrap packages.
(let ((base-packages (delete-duplicates
(append-map (match-lambda
((_ package _ ...)
(match (package-transitive-inputs
package)
(((_ inputs _ ...) ...)
inputs))))
%final-inputs))))
(append-map (lambda (system)
(case subset
((all)
;; Build everything.
(fold-packages (lambda (package result)
(if (member package base-packages)
result
(cons (package-job store (job-name package)
package system)
result)))
(append (qemu-jobs store system)
(cross-jobs system))))
((core)
;; Build core packages only.
(append (map (lambda (package)
(package-job store (job-name package)
package system))
%core-packages)
(cross-jobs system)))
(else
(error "unknown subset" subset))))
systems)))
(append-map (lambda (system)
(case subset
((all)
;; Build everything.
(fold-packages (lambda (package result)
(let ((job (package->job store package
system)))
(if job
(cons job result)
result)))
(append (qemu-jobs store system)
(cross-jobs system))))
((core)
;; Build core packages only.
(append (map (lambda (package)
(package-job store (job-name package)
package system))
%core-packages)
(cross-jobs system)))
(else
(error "unknown subset" subset))))
%supported-systems))