mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
hydra: Honor 'package-supported-systems'.
* 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
parent
288dca55a8
commit
4e097f8606
2 changed files with 60 additions and 40 deletions
|
|
@ -154,21 +154,41 @@ (define MiB
|
|||
(* 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 @@ (define (either proc1 proc2)
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ (define-module (guix packages)
|
|||
package-description
|
||||
package-license
|
||||
package-home-page
|
||||
package-platforms
|
||||
package-supported-systems
|
||||
package-maintainers
|
||||
package-properties
|
||||
package-location
|
||||
|
|
@ -85,6 +85,8 @@ (define-module (guix packages)
|
|||
package-cross-derivation
|
||||
package-output
|
||||
|
||||
%supported-systems
|
||||
|
||||
&package-error
|
||||
package-error?
|
||||
package-error-package
|
||||
|
|
@ -173,6 +175,11 @@ (define (search-path-specification->sexp spec)
|
|||
(($ <search-path-specification> variable directories separator)
|
||||
`(,variable ,directories ,separator))))
|
||||
|
||||
(define %supported-systems
|
||||
;; This is the list of system types that are supported. By default, we
|
||||
;; expect all packages to build successfully here.
|
||||
'("x86_64-linux" "i686-linux" "mips64el-linux"))
|
||||
|
||||
;; A package.
|
||||
(define-record-type* <package>
|
||||
package make-package
|
||||
|
|
@ -208,7 +215,8 @@ (define-record-type* <package>
|
|||
(description package-description) ; one or two paragraphs
|
||||
(license package-license)
|
||||
(home-page package-home-page)
|
||||
(platforms package-platforms (default '()))
|
||||
(supported-systems package-supported-systems ; list of strings
|
||||
(default %supported-systems))
|
||||
(maintainers package-maintainers (default '()))
|
||||
|
||||
(properties package-properties (default '())) ; alist for anything else
|
||||
|
|
|
|||
Loading…
Reference in a new issue