ci: Allow manifests to contain any lowerable object.
Previously, manifests could only contain packages: https://lists.gnu.org/archive/html/guix-devel/2021-10/msg00002.html This allows us to pass origins as found in 'etc/source-manifest.scm'. * gnu/ci.scm (derivation->job): Change default #:timeout value to 5h. (manifests->packages): Remove. (manifests->jobs): New procedure. (cuirass-jobs): Use it in the 'manifests' case.master
parent
b628c5fc71
commit
688a4db071
47
gnu/ci.scm
47
gnu/ci.scm
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
|
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
|
||||||
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
|
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
|
||||||
|
@ -86,7 +86,7 @@
|
||||||
(define* (derivation->job name drv
|
(define* (derivation->job name drv
|
||||||
#:key
|
#:key
|
||||||
(max-silent-time 3600)
|
(max-silent-time 3600)
|
||||||
(timeout 3600))
|
(timeout (* 5 3600)))
|
||||||
"Return a Cuirass job called NAME and describing DRV.
|
"Return a Cuirass job called NAME and describing DRV.
|
||||||
|
|
||||||
MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
|
MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
|
||||||
|
@ -443,19 +443,40 @@ valid."
|
||||||
(map channel-url channels)))
|
(map channel-url channels)))
|
||||||
arguments))
|
arguments))
|
||||||
|
|
||||||
(define (manifests->packages store manifests)
|
(define (manifests->jobs store manifests)
|
||||||
"Return the list of packages found in MANIFESTS."
|
"Return the list of jobs for the entries in MANIFESTS, a list of file
|
||||||
|
names."
|
||||||
(define (load-manifest manifest)
|
(define (load-manifest manifest)
|
||||||
(save-module-excursion
|
(save-module-excursion
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set-current-module (make-user-module '((guix profiles) (gnu))))
|
(set-current-module (make-user-module '((guix profiles) (gnu))))
|
||||||
(primitive-load manifest))))
|
(primitive-load manifest))))
|
||||||
|
|
||||||
(delete-duplicates!
|
(define (manifest-entry-job-name entry)
|
||||||
(map manifest-entry-item
|
(string-append (manifest-entry-name entry) "-"
|
||||||
(append-map (compose manifest-entries
|
(manifest-entry-version entry)))
|
||||||
load-manifest)
|
|
||||||
manifests))))
|
(define (manifest-entry->job entry)
|
||||||
|
(let* ((obj (manifest-entry-item entry))
|
||||||
|
(drv (parameterize ((%graft? #f))
|
||||||
|
(run-with-store store
|
||||||
|
(lower-object obj))))
|
||||||
|
(max-silent-time (or (and (package? obj)
|
||||||
|
(assoc-ref (package-properties obj)
|
||||||
|
'max-silent-time))
|
||||||
|
3600))
|
||||||
|
(timeout (or (and (package? obj)
|
||||||
|
(assoc-ref (package-properties obj) 'timeout))
|
||||||
|
(* 5 3600))))
|
||||||
|
(derivation->job (manifest-entry-job-name entry) drv
|
||||||
|
#:max-silent-time max-silent-time
|
||||||
|
#:timeout timeout)))
|
||||||
|
|
||||||
|
(map manifest-entry->job
|
||||||
|
(delete-duplicates
|
||||||
|
(append-map (compose manifest-entries load-manifest)
|
||||||
|
manifests)
|
||||||
|
manifest-entry=?)))
|
||||||
|
|
||||||
(define (arguments->systems arguments)
|
(define (arguments->systems arguments)
|
||||||
"Return the systems list from ARGUMENTS."
|
"Return the systems list from ARGUMENTS."
|
||||||
|
@ -568,12 +589,8 @@ valid."
|
||||||
packages)))
|
packages)))
|
||||||
(('manifests . rest)
|
(('manifests . rest)
|
||||||
;; Build packages in the list of manifests.
|
;; Build packages in the list of manifests.
|
||||||
(let* ((manifests (arguments->manifests rest channels))
|
(let ((manifests (arguments->manifests rest channels)))
|
||||||
(packages (manifests->packages store manifests)))
|
(manifests->jobs store manifests)))
|
||||||
(map (lambda (package)
|
|
||||||
(package-job store (job-name package)
|
|
||||||
package system))
|
|
||||||
packages)))
|
|
||||||
(else
|
(else
|
||||||
(error "unknown subset" subset))))
|
(error "unknown subset" subset))))
|
||||||
systems)))
|
systems)))
|
||||||
|
|
Reference in New Issue