me
/
guix
Archived
1
0
Fork 0

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'.
Ludovic Courtès 2023-08-21 15:37:11 +02:00
parent df2117b8e0
commit 97f062f33c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 10 deletions

View File

@ -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)))