From 560cb51e7b37e2c6f6fe4b72a3781185c57fdf83 Mon Sep 17 00:00:00 2001 From: Christopher Baines 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 Signed-off-by: Josselin Poiret Signed-off-by: Ludovic Courtès --- gnu/ci.scm | 46 ++++++++++++++++++++------------------ gnu/packages/base.scm | 7 +++--- gnu/packages/commencement.scm | 51 ++++++++++++++++++++++--------------------- 3 files changed, 55 insertions(+), 49 deletions(-) diff --git a/gnu/ci.scm b/gnu/ci.scm index 7acd88ed29..df98c8af97 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -24,6 +24,7 @@ (define-module (gnu ci) #: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 @@ (define job-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 1fdfaf8a57..32bc69e2c4 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -78,7 +78,8 @@ (define-module (gnu packages base) #:export (glibc libc-for-target make-ld-wrapper - libiconv-if-needed)) + libiconv-if-needed + %final-inputs)) ;;; Commentary: ;;; @@ -1648,10 +1649,10 @@ (define-public (canonical-package package) (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 fe6f025257..e522e70444 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -3459,31 +3459,32 @@ (define-public %final-inputs ;; 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) -- cgit v1.2.3