ci: Honor user-specific systems for manifests.
* gnu/ci.scm (manifests->jobs): Add 'systems' argument. [manifest-entry->job]: Add 'system' and honor it. Honor it. (cuirass-jobs): Pass SYSTEMS to 'manifests->jobs'.
parent
df2117b8e0
commit
97f062f33c
23
gnu/ci.scm
23
gnu/ci.scm
|
@ -421,9 +421,9 @@ valid. Append SUFFIX to the job name."
|
||||||
(map channel-url channels)))
|
(map channel-url channels)))
|
||||||
arguments))
|
arguments))
|
||||||
|
|
||||||
(define (manifests->jobs store manifests)
|
(define (manifests->jobs store manifests systems)
|
||||||
"Return the list of jobs for the entries in MANIFESTS, a list of file
|
"Return the list of jobs for the entries in MANIFESTS, a list of file
|
||||||
names."
|
names, for each one of SYSTEMS."
|
||||||
(define (load-manifest manifest)
|
(define (load-manifest manifest)
|
||||||
(save-module-excursion
|
(save-module-excursion
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -434,11 +434,12 @@ names."
|
||||||
(string-append (manifest-entry-name entry) "-"
|
(string-append (manifest-entry-name entry) "-"
|
||||||
(manifest-entry-version entry)))
|
(manifest-entry-version entry)))
|
||||||
|
|
||||||
(define (manifest-entry->job entry)
|
(define (manifest-entry->job entry system)
|
||||||
(let* ((obj (manifest-entry-item entry))
|
(let* ((obj (manifest-entry-item entry))
|
||||||
(drv (parameterize ((%graft? #f))
|
(drv (parameterize ((%graft? #f))
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
(lower-object obj))))
|
(lower-object obj)
|
||||||
|
#:system system)))
|
||||||
(max-silent-time (or (and (package? obj)
|
(max-silent-time (or (and (package? obj)
|
||||||
(assoc-ref (package-properties obj)
|
(assoc-ref (package-properties obj)
|
||||||
'max-silent-time))
|
'max-silent-time))
|
||||||
|
@ -450,11 +451,13 @@ names."
|
||||||
#:max-silent-time max-silent-time
|
#:max-silent-time max-silent-time
|
||||||
#:timeout timeout)))
|
#:timeout timeout)))
|
||||||
|
|
||||||
(map manifest-entry->job
|
(let ((entries (delete-duplicates
|
||||||
(delete-duplicates
|
(append-map (compose manifest-entries load-manifest)
|
||||||
(append-map (compose manifest-entries load-manifest)
|
manifests)
|
||||||
manifests)
|
manifest-entry=?)))
|
||||||
manifest-entry=?)))
|
(append-map (lambda (system)
|
||||||
|
(map (cut manifest-entry->job <> system) entries))
|
||||||
|
systems)))
|
||||||
|
|
||||||
(define (arguments->systems arguments)
|
(define (arguments->systems arguments)
|
||||||
"Return the systems list from ARGUMENTS."
|
"Return the systems list from ARGUMENTS."
|
||||||
|
@ -576,7 +579,7 @@ names."
|
||||||
(('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)))
|
||||||
(manifests->jobs store manifests)))
|
(manifests->jobs store manifests systems)))
|
||||||
(else
|
(else
|
||||||
(error "unknown subset" subset))))
|
(error "unknown subset" subset))))
|
||||||
systems)))
|
systems)))
|
||||||
|
|
Reference in New Issue