From 560cb51e7b37e2c6f6fe4b72a3781185c57fdf83 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 9 Aug 2023 09:38:31 +0200
Subject: gnu: commencement: Use system in %final-inputs.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Otherwise this causes odd issues, I presume arising from when %current-system
differs from the system argument passed to %final-inputs.

* gnu/packages/commencement.scm (%final-inputs): Set %current-system to
system.
* gnu/packages/base.scm (%final-inputs): Add optional system parameter.
* gnu/ci.scm (base-packages): New procedure to memoize the base packages
depending on system.
(package->job): Pass system to base-packages.

Co-authored-by: Josselin Poiret <dev@jpoiret.xyz>
Signed-off-by: Josselin Poiret <dev@jpoiret.xyz>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/ci.scm | 46 +++++++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 21 deletions(-)

(limited to 'gnu/ci.scm')

diff --git a/gnu/ci.scm b/gnu/ci.scm
index 7acd88ed29b..df98c8af972 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -24,6 +24,7 @@
   #:use-module (guix build-system channel)
   #:use-module (guix config)
   #:autoload   (guix describe) (package-channels)
+  #:use-module (guix memoization)
   #:use-module (guix store)
   #:use-module (guix profiles)
   #:use-module (guix packages)
@@ -342,29 +343,32 @@ otherwise use the IMAGE name."
   ;; Return the name of a package's job.
   package-name)
 
+(define base-packages
+  (mlambda (system)
+    "Return the set of packages considered to be part of the base for SYSTEM."
+    (delete-duplicates
+     (append-map (match-lambda
+                   ((_ package _ ...)
+                    (match (package-transitive-inputs package)
+                      (((_ inputs _ ...) ...)
+                       inputs))))
+                 (%final-inputs system)))))
+
 (define package->job
-  (let ((base-packages
-         (delete-duplicates
-          (append-map (match-lambda
-                        ((_ package _ ...)
-                         (match (package-transitive-inputs package)
-                           (((_ inputs _ ...) ...)
-                            inputs))))
-                      (%final-inputs)))))
-    (lambda* (store package system #:key (suffix ""))
-      "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
+  (lambda* (store package system #:key (suffix ""))
+    "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
 valid.  Append SUFFIX to the job name."
-      (cond ((member package base-packages)
-             (package-job store (string-append "base." (job-name package))
-                          package system #:suffix suffix))
-            ((supported-package? package system)
-             (let ((drv (package-derivation store package system
-                                            #:graft? #f)))
-               (and (substitutable-derivation? drv)
-                    (package-job store (job-name package)
-                                 package system #:suffix suffix))))
-            (else
-             #f)))))
+    (cond ((member package (base-packages system))
+           (package-job store (string-append "base." (job-name package))
+                        package system #:suffix suffix))
+          ((supported-package? package system)
+           (let ((drv (package-derivation store package system
+                                          #:graft? #f)))
+             (and (substitutable-derivation? drv)
+                  (package-job store (job-name package)
+                               package system #:suffix suffix))))
+          (else
+           #f))))
 
 (define %x86-64-micro-architectures
   ;; Micro-architectures for which we build tuned variants.
-- 
cgit v1.3