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'.
This commit is contained in:
		
							parent
							
								
									df2117b8e0
								
							
						
					
					
						commit
						97f062f33c
					
				
					 1 changed files with 13 additions and 10 deletions
				
			
		
							
								
								
									
										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 a new issue