diff options
Diffstat (limited to 'tests/gnu-system.scm')
| -rw-r--r-- | tests/gnu-system.scm | 107 |
1 files changed, 48 insertions, 59 deletions
diff --git a/tests/gnu-system.scm b/tests/gnu-system.scm index d58f47e..caacacd 100644 --- a/tests/gnu-system.scm +++ b/tests/gnu-system.scm @@ -66,33 +66,25 @@ (timeout . ,(or (assoc-ref (package-properties package) 'timeout) 72000)))) ;20 hours by default -(define (package-job-spec store job-name package system) - "Return a non evaluated job called JOB-NAME that builds PACKAGE on SYSTEM." - (make-job-spec - #:name - (string-append (symbol->string job-name) "." system) - #:procedure - (λ () - (derivation-file-name - (parameterize ((%graft? #f)) - (package-derivation store package system #:graft? #f)))) - #:metadata - (package-metadata package))) - -(define (package-cross-job-spec store job-name package target system) - "Return a non evaluated job called TARGET.JOB-NAME that cross-builds PACKAGE +(define (package-job store job-name package system) + "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." + (make-job + #:name (string-append (symbol->string job-name) "." system) + #:derivation (derivation-file-name + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f))) + #:metadata (package-metadata package))) + +(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." - (make-job-spec - #:name - (string-append target "." (symbol->string job-name) "." system) - #:procedure - (λ () - (derivation-file-name - (parameterize ((%graft? #f)) - (package-cross-derivation store package target system - #:graft? #f)))) - #:metadata - (package-metadata package))) + (make-job + #:name (string-append target "." (symbol->string job-name) "." system) + #:derivation (derivation-file-name + (parameterize ((%graft? #f)) + (package-cross-derivation store package target system + #:graft? #f))) + #:metadata (package-metadata package))) (define %core-packages ;; Note: Don't put the '-final' package variants because (1) that's @@ -115,21 +107,18 @@ for TARGET on SYSTEM." '("mips64el-linux-gnu" "mips64el-linux-gnuabi64")) -(define (tarball-job-specs store system) +(define (tarball-jobs store system) "Return Hydra jobs to build the self-contained Guix binary tarball." (list - (make-job-spec - #:name - (string-append "binary-tarball." system) - #:procedure - (λ () - (derivation-file-name - (parameterize ((%graft? #f)) - (run-with-store store - (mbegin %store-monad - (set-guile-for-build (default-guile)) - (self-contained-tarball)) - #:system system)))) + (make-job + #:name (string-append "binary-tarball." system) + #:derivation (derivation-file-name + (parameterize ((%graft? #f)) + (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (self-contained-tarball)) + #:system system))) #:metadata `((description . "Stand-alone binary Guix tarball") (long-description . "This is a tarball containing binaries of Guix and @@ -138,11 +127,11 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.") (home-page . ,%guix-home-page-url) (maintainers . ("bug-guix@gnu.org")))))) -(define job-name +(define %job-name ;; Return the name of a package's job. (compose string->symbol package-full-name)) -(define package->job-spec +(define package->job (let ((base-packages (delete-duplicates (append-map (match-lambda @@ -157,7 +146,7 @@ valid." (cond ((member package base-packages) #f) ((supported-package? package system) - (package-job-spec store (job-name package) package system)) + (package-job store (%job-name package) package system)) (else #f))))) @@ -195,8 +184,8 @@ valid." (append-map (lambda (target) (map (lambda (package) - (package-cross-job-spec store (job-name package) - package target system)) + (package-cross-job store (job-name package) + package target system)) %packages-to-cross-build)) (remove (either from-32-to-64? same?) %cross-targets))) @@ -207,30 +196,30 @@ valid." (case subset ((all) ;; Build everything, including replacements. - (let ((all (fold-packages - (lambda (package result) - (if (package-replacement package) - (cons* package - (package-replacement package) - result) - (cons package result))) - '())) - (job (lambda (package) - (package->job-spec store package system)))) - (append (filter-map job all) - (tarball-job-specs store system) + (let ((pkgs (fold-packages + (lambda (package result) + (if (package-replacement package) + (cons* package + (package-replacement package) + result) + (cons package result))) + '()))) + (append (filter-map (lambda (pkg) + (package->job store pkg system)) + pkgs) + (tarball-jobs store system) (cross-jobs system)))) ((core) ;; Build core packages only. (append (map (lambda (package) - (package-job-spec store (job-name package) - package system)) + (package-job store (job-name package) + package system)) %core-packages) (cross-jobs system))) ((hello) ;; Build hello package only. (if (string=? system (%current-system)) - (list (package-job-spec store (job-name hello) hello system)) + (list (package-job store (%job-name hello) hello system)) '())) (else (error "unknown subset" subset)))) |