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 2014-10-06 19:14:47 +02:00
parent 288dca55a8
commit 4e097f8606
2 changed files with 60 additions and 40 deletions

View File

@ -154,21 +154,41 @@ system.")
(* 630 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) (define (hydra-jobs store arguments)
"Return Hydra jobs." "Return Hydra jobs."
(define systems
;; Systems we want to build for.
'("x86_64-linux" "i686-linux"
"mips64el-linux"))
(define subset (define subset
(match (assoc-ref arguments 'subset) (match (assoc-ref arguments 'subset)
("core" 'core) ; only build core packages ("core" 'core) ; only build core packages
(_ 'all))) ; build everything (_ 'all))) ; build everything
(define job-name
(compose string->symbol package-full-name))
(define (cross-jobs system) (define (cross-jobs system)
(define (from-32-to-64? target) (define (from-32-to-64? target)
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.
@ -195,23 +215,15 @@ system.")
(remove (either from-32-to-64? same?) %cross-targets))) (remove (either from-32-to-64? same?) %cross-targets)))
;; Return one job for each package, except bootstrap packages. ;; 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) (append-map (lambda (system)
(case subset (case subset
((all) ((all)
;; Build everything. ;; Build everything.
(fold-packages (lambda (package result) (fold-packages (lambda (package result)
(if (member package base-packages) (let ((job (package->job store package
result system)))
(cons (package-job store (job-name package) (if job
package system) (cons job result)
result))) result)))
(append (qemu-jobs store system) (append (qemu-jobs store system)
(cross-jobs system)))) (cross-jobs system))))
@ -224,4 +236,4 @@ system.")
(cross-jobs system))) (cross-jobs system)))
(else (else
(error "unknown subset" subset)))) (error "unknown subset" subset))))
systems))) %supported-systems))

View File

@ -69,7 +69,7 @@
package-description package-description
package-license package-license
package-home-page package-home-page
package-platforms package-supported-systems
package-maintainers package-maintainers
package-properties package-properties
package-location package-location
@ -85,6 +85,8 @@
package-cross-derivation package-cross-derivation
package-output package-output
%supported-systems
&package-error &package-error
package-error? package-error?
package-error-package package-error-package
@ -173,6 +175,11 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(($ <search-path-specification> variable directories separator) (($ <search-path-specification> variable directories separator)
`(,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. ;; A package.
(define-record-type* <package> (define-record-type* <package>
package make-package package make-package
@ -208,7 +215,8 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(description package-description) ; one or two paragraphs (description package-description) ; one or two paragraphs
(license package-license) (license package-license)
(home-page package-home-page) (home-page package-home-page)
(platforms package-platforms (default '())) (supported-systems package-supported-systems ; list of strings
(default %supported-systems))
(maintainers package-maintainers (default '())) (maintainers package-maintainers (default '()))
(properties package-properties (default '())) ; alist for anything else (properties package-properties (default '())) ; alist for anything else