gnu: commencement: Use system in %final-inputs.

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>

3 files changed, 55 insertions, 49 deletions

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.
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 1fdfaf8a57e..32bc69e2c44 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -78,7 +78,8 @@
   #:export (glibc
             libc-for-target
             make-ld-wrapper
-            libiconv-if-needed))
+            libiconv-if-needed
+            %final-inputs))
 
 ;;; Commentary:
 ;;;
@@ -1648,10 +1649,10 @@ package needs iconv ,@(libiconv-if-needed) should be added."
          (proc  (module-ref iface 'canonical-package)))
     (proc package)))
 
-(define-public (%final-inputs)
+(define* (%final-inputs #:optional (system (%current-system)))
   "Return the list of \"final inputs\"."
   ;; Avoid circular dependency by lazily resolving 'commencement'.
   (let ((iface (resolve-interface '(gnu packages commencement))))
-    ((module-ref iface '%final-inputs) (%current-system))))
+    ((module-ref iface '%final-inputs) system)))
 
 ;;; base.scm ends here
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index fe6f0252571..e522e70444e 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -3459,31 +3459,32 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
     ;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
     ;; used for origins that have patches, thereby avoiding circular
     ;; dependencies.
-    (let ((finalize (compose with-boot6
-                             package-with-bootstrap-guile)))
-      `(,@(map (match-lambda
-                 ((name package)
-                  (list name (finalize package))))
-               `(("tar" ,tar)
-                 ("gzip" ,gzip)
-                 ("bzip2" ,bzip2)
-                 ("file" ,file)
-                 ("diffutils" ,diffutils)
-                 ("patch" ,patch)
-                 ("findutils" ,findutils)
-                 ("gawk" ,gawk)))
-        ("sed" ,sed-final)
-        ("grep" ,grep-final)
-        ("xz" ,xz-final)
-        ("coreutils" ,coreutils-final)
-        ("make" ,gnu-make-final)
-        ("bash" ,bash-final)
-        ("ld-wrapper" ,ld-wrapper)
-        ("binutils" ,binutils-final)
-        ("gcc" ,gcc-final)
-        ("libc" ,glibc-final)
-        ("libc:static" ,glibc-final "static")
-        ("locales" ,glibc-utf8-locales-final)))))
+    (parameterize ((%current-system system))
+      (let ((finalize (compose with-boot6
+                               package-with-bootstrap-guile)))
+        `(,@(map (match-lambda
+                   ((name package)
+                    (list name (finalize package))))
+                 `(("tar" ,tar)
+                   ("gzip" ,gzip)
+                   ("bzip2" ,bzip2)
+                   ("file" ,file)
+                   ("diffutils" ,diffutils)
+                   ("patch" ,patch)
+                   ("findutils" ,findutils)
+                   ("gawk" ,gawk)))
+          ("sed" ,sed-final)
+          ("grep" ,grep-final)
+          ("xz" ,xz-final)
+          ("coreutils" ,coreutils-final)
+          ("make" ,gnu-make-final)
+          ("bash" ,bash-final)
+          ("ld-wrapper" ,ld-wrapper)
+          ("binutils" ,binutils-final)
+          ("gcc" ,gcc-final)
+          ("libc" ,glibc-final)
+          ("libc:static" ,glibc-final "static")
+          ("locales" ,glibc-utf8-locales-final))))))
 
 (define-public canonical-package
   (let ((name->package (mlambda (system)