me
/
guix
Archived
1
0
Fork 0
Code

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>
Christopher Baines 2023-08-09 09:38:31 +02:00 committed by Ludovic Courtès
parent 10f3dd0e9e
commit 560cb51e7b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 55 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gnu/ci.scm
View File

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

7
gnu/packages/base.scm
View File

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

51
gnu/packages/commencement.scm
View File

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