build: `hydra.scm' adds cross-build jobs.

* hydra.scm (package->alist): Add `package-derivation' argument.
  (package-cross-job): New procedure.
  (%packages-to-cross-build, %cross-targets): New variables.
  (hydra-jobs): Add cross jobs.
This commit is contained in:
Ludovic Courtès 2013-05-24 23:12:56 +02:00
parent e55ec43d8b
commit 929c0f69de
1 changed files with 37 additions and 7 deletions

View File

@ -42,6 +42,8 @@
(gnu packages) (gnu packages)
(gnu packages base) (gnu packages base)
(gnu packages guile) (gnu packages guile)
(gnu packages multiprecision)
(gnu packages make-bootstrap)
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-26) (srfi srfi-26)
(ice-9 match)) (ice-9 match))
@ -51,7 +53,8 @@
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port)) (set-current-output-port (current-error-port))
(define (package->alist store package system) (define* (package->alist store package system
#:optional (package-derivation package-derivation))
"Convert PACKAGE to an alist suitable for Hydra." "Convert PACKAGE to an alist suitable for Hydra."
`((derivation . ,(package-derivation store package system)) `((derivation . ,(package-derivation store package system))
(description . ,(package-synopsis package)) (description . ,(package-synopsis package))
@ -64,12 +67,41 @@
"Return a job called JOB-NAME that builds PACKAGE on SYSTEM." "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
`(,job-name . ,(cut package->alist store package system))) `(,job-name . ,(cut package->alist store package system)))
(define (package-cross-job store job-name package target system)
"Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
SYSTEM."
`(,(symbol-append (string->symbol target) (string->symbol ".") job-name) .
,(cute package->alist store package system
(cut package-cross-derivation <> <> target <>))))
(define %packages-to-cross-build
(list gmp mpfr mpc coreutils findutils diffutils patch hello guile-2.0
%bootstrap-binaries-tarball
%binutils-bootstrap-tarball
%glibc-bootstrap-tarball
%gcc-bootstrap-tarball
%guile-bootstrap-tarball))
(define %cross-targets
'("mips64el-linux-gnu"))
(define (hydra-jobs store arguments) (define (hydra-jobs store arguments)
"Return Hydra jobs." "Return Hydra jobs."
(define system (define system
(or (assoc-ref arguments system) (or (assoc-ref arguments system)
(%current-system))) (%current-system)))
(define job-name
(compose string->symbol package-full-name))
(define cross-jobs
(append-map (lambda (target)
(map (lambda (package)
(package-cross-job store (job-name package)
package target system))
%packages-to-cross-build))
%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 (let ((base-packages (delete-duplicates
(append-map (match-lambda (append-map (match-lambda
@ -82,9 +114,7 @@
(fold-packages (lambda (package result) (fold-packages (lambda (package result)
(if (member package base-packages) (if (member package base-packages)
result result
(let ((name (string->symbol (cons (package-job store (job-name package)
(package-full-name package)))) package system)
(cons (package-job store name package result)))
system) cross-jobs)))
result))))
'())))