diff options
Diffstat (limited to 'build-aux/hydra/gnu-system.scm')
| -rw-r--r-- | build-aux/hydra/gnu-system.scm | 88 |
1 files changed, 50 insertions, 38 deletions
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index c24f4ab512..c26bcff6ae 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -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)) |