* bug#60056: cross-compilation doesn't honor gcc native input
@ 2022-12-14 2:16 Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
0 siblings, 1 reply; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-14 2:16 UTC (permalink / raw)
To: 60056
Hello Guix,
I've recently noticed that cross-compiling with a different GCC was not
possible by simply adding them as native inputs the same way we can
already do when compiling natively.
Here's an example in our package collection that fails to cross-compile
for that reason:
--8<---------------cut here---------------start------------->8---
$ guix build --target=arm-linux-gnueabihf --no-offload glibc@2.30
[...]
arm-linux-gnueabihf-gcc ../sysdeps/arm/aeabi_lcsts.c -c -std=gnu11 -fgnu89-inline -g -O2 -Wall -Wwrite-strings -Wundef -Werror -fmerge-all-constants -frounding-math -fno-stack-protector -Wstrict-prototypes -Wold-style-definition -fmath-errno -fno-stack-protector -DSTACK_PROTECTOR_LEVEL=0 -ftls-model=initial-exec -I../include -I/tmp/guix-build-glibc-2.30.drv-0/build/csu -I/tmp/guix-build-glibc-2.30.drv-0/build -I../sysdeps/unix/sysv/linux/arm -I../sysdeps/arm/nptl -I../sysdeps/unix/sysv/linux/include -I../sysdeps/unix/sysv/linux -I../sysdeps/nptl -I../sysdeps/pthread -I../sysdeps/gnu -I../sysdeps/unix/inet -I../sysdeps/unix/sysv -I../sysdeps/unix/arm -I../sysdeps/unix -I../sysdeps/posix -I../sysdeps/arm/armv7/multiarch -I../sysdeps/arm/armv7 -I../sysdeps/arm/armv6t2 -I../sysdeps/arm/armv6 -I../sysdeps/arm/include -I../sysdeps/arm -I../sysdeps/wordsize-32 -I../sysdeps/ieee754/flt-32 -I../sysdeps/ieee754/dbl-64 -I../sysdeps/ieee754 -I../sysdeps/generic -I.. -I../libio -I. -nostdinc -isystem /gnu/store/qxiyl966akwfj44vkswams3db61r45m7-gcc-cross-arm-linux-gnueabihf-10.3.0-lib/lib/gcc/arm-linux-gnueabihf/10.3.0/include -isystem /gnu/store/qxiyl966akwfj44vkswams3db61r45m7-gcc-cross-arm-linux-gnueabihf-10.3.0-lib/lib/gcc/arm-linux-gnueabihf/10.3.0/include-fixed -isystem /gnu/store/k4lzn762cpwwznxc2gvcyidfjnx3yw7b-linux-libre-headers-5.10.35/include -D_LIBC_REENTRANT -include /tmp/guix-build-glibc-2.30.drv-0/build/libc-modules.h -DMODULE_NAME=libc -include ../include/libc-symbols.h -DTOP_NAMESPACE=glibc -o /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_lcsts.o -MD -MP -MF /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_lcsts.o.dt -MT /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_lcsts.o
In file included from ../sysdeps/arm/libc-tls.c:19:
../csu/libc-tls.c: In function ‘__libc_setup_tls’:
../csu/libc-tls.c:209:30: error: array subscript 1 is outside the bounds of an interior zero-length array ‘struct dtv_slotinfo[0]’ [-Werror=zero-length-bounds]
209 | static_slotinfo.si.slotinfo[1].map = main_map;
| ~~~~~~~~~~~~~~~~~~~~~~~~~~~^~~
In file included from ../sysdeps/arm/ldsodefs.h:38,
from ../sysdeps/gnu/ldsodefs.h:46,
from ../sysdeps/unix/sysv/linux/ldsodefs.h:25,
from ../sysdeps/unix/sysv/linux/arm/ldsodefs.h:22,
from ../csu/libc-tls.c:21,
from ../sysdeps/arm/libc-tls.c:19:
../sysdeps/generic/ldsodefs.h:406:7: note: while referencing ‘slotinfo’
406 | } slotinfo[0];
| ^~~~~~~~
arm-linux-gnueabihf-gcc ../sysdeps/arm/aeabi_sighandlers.S -c -I../include -I/tmp/guix-build-glibc-2.30.drv-0/build/csu -I/tmp/guix-build-glibc-2.30.drv-0/build -I../sysdeps/unix/sysv/linux/arm -I../sysdeps/arm/nptl -I../sysdeps/unix/sysv/linux/include -I../sysdeps/unix/sysv/linux -I../sysdeps/nptl -I../sysdeps/pthread -I../sysdeps/gnu -I../sysdeps/unix/inet -I../sysdeps/unix/sysv -I../sysdeps/unix/arm -I../sysdeps/unix -I../sysdeps/posix -I../sysdeps/arm/armv7/multiarch -I../sysdeps/arm/armv7 -I../sysdeps/arm/armv6t2 -I../sysdeps/arm/armv6 -I../sysdeps/arm/include -I../sysdeps/arm -I../sysdeps/wordsize-32 -I../sysdeps/ieee754/flt-32 -I../sysdeps/ieee754/dbl-64 -I../sysdeps/ieee754 -I../sysdeps/generic -I.. -I../libio -I. -nostdinc -isystem /gnu/store/qxiyl966akwfj44vkswams3db61r45m7-gcc-cross-arm-linux-gnueabihf-10.3.0-lib/lib/gcc/arm-linux-gnueabihf/10.3.0/include -isystem /gnu/store/qxiyl966akwfj44vkswams3db61r45m7-gcc-cross-arm-linux-gnueabihf-10.3.0-lib/lib/gcc/arm-linux-gnueabihf/10.3.0/include-fixed -isystem /gnu/store/k4lzn762cpwwznxc2gvcyidfjnx3yw7b-linux-libre-headers-5.10.35/include -D_LIBC_REENTRANT -include /tmp/guix-build-glibc-2.30.drv-0/build/libc-modules.h -DMODULE_NAME=libc -include ../include/libc-symbols.h -DTOP_NAMESPACE=glibc -DASSEMBLER -I/tmp/guix-build-glibc-2.30.drv-0/build/csu/. -g -Werror=undef -Wa,--noexecstack -o /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_sighandlers.o -MD -MP -MF /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_sighandlers.o.dt -MT /tmp/guix-build-glibc-2.30.drv-0/build/csu/aeabi_sighandlers.o
cc1: all warnings being treated as errors
make[2]: *** [/tmp/guix-build-glibc-2.30.drv-0/build/sysd-rules:519: /tmp/guix-build-glibc-2.30.drv-0/build/csu/libc-tls.o] Error 1
make[2]: *** Waiting for unfinished jobs....
make[2]: Leaving directory '/tmp/guix-build-glibc-2.30.drv-0/glibc-2.30/csu'
make[1]: *** [Makefile:259: csu/subdir_lib] Error 2
make[1]: Leaving directory '/tmp/guix-build-glibc-2.30.drv-0/glibc-2.30'
make: *** [Makefile:9: all] Error 2
error: in phase 'build': uncaught exception:
%exception #<&invoke-error program: "make" arguments: ("-j" "4") exit-status: 2 term-signal: #f stop-signal: #f>
phase `build' failed after 8.5 seconds
command "make" "-j" "4" failed with status 2
builder for `/gnu/store/cpabyq7ly2sf1jxxbn8srbqkd9chz9w1-glibc-2.30.drv' failed with exit code 1
build of /gnu/store/cpabyq7ly2sf1jxxbn8srbqkd9chz9w1-glibc-2.30.drv failed
--8<---------------cut here---------------end--------------->8---
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2.
2022-12-14 2:16 bug#60056: cross-compilation doesn't honor gcc native input Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 2/6] build: gnu-build-system2: Remove source from native inputs Maxim Cournoyer
` (5 more replies)
0 siblings, 6 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
* guix/build/gnu-build-system2.scm: New file.
* Makefile.am (MODULES): Register it.
* guix/build-system/gnu2.scm: Use it.
---
Makefile.am | 2 +
guix/build-system/gnu2.scm | 580 +++++++++++++++++++
guix/build/gnu-build-system2.scm | 937 +++++++++++++++++++++++++++++++
3 files changed, 1519 insertions(+)
create mode 100644 guix/build-system/gnu2.scm
create mode 100644 guix/build/gnu-build-system2.scm
diff --git a/Makefile.am b/Makefile.am
index b54288c0fc..a331385aa1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -159,6 +159,7 @@ MODULES = \
guix/build-system/copy.scm \
guix/build-system/glib-or-gtk.scm \
guix/build-system/gnu.scm \
+ guix/build-system/gnu2.scm \
guix/build-system/guile.scm \
guix/build-system/haskell.scm \
guix/build-system/julia.scm \
@@ -217,6 +218,7 @@ MODULES = \
guix/build/glib-or-gtk-build-system.scm \
guix/build/gnu-bootstrap.scm \
guix/build/gnu-build-system.scm \
+ guix/build/gnu-build-system2.scm \
guix/build/gnu-dist.scm \
guix/build/guile-build-system.scm \
guix/build/maven-build-system.scm \
diff --git a/guix/build-system/gnu2.scm b/guix/build-system/gnu2.scm
new file mode 100644
index 0000000000..95fce76714
--- /dev/null
+++ b/guix/build-system/gnu2.scm
@@ -0,0 +1,580 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system gnu2)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (guix memoization)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
+ #:use-module (guix derivations)
+ #:use-module (guix search-paths)
+ #:use-module (guix build-system)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:export (%gnu-build-system-modules2
+ gnu-build2
+ gnu-build-system2
+ standard-packages2
+ standard-cross-packages2
+ package-with-explicit-inputs2
+ package-with-extra-configure-variable2
+ static-libgcc-package2
+ static-package2
+ dist-package2
+ package-with-restricted-references2))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install").
+;;
+;; Code:
+
+(define %gnu-build-system-modules2
+ ;; Build-side modules imported and used by default.
+ '((guix build gnu-build-system2)
+ (guix build utils)
+ (guix build gremlin)
+ (guix elf)))
+
+(define %default-modules
+ ;; Modules in scope in the build-side environment.
+ '((guix build gnu-build-system2)
+ (guix build utils)))
+
+(define* (package-with-explicit-inputs/deprecated p inputs
+ #:optional
+ (loc (current-source-location))
+ #:key (native-inputs '())
+ guile)
+ "This variant is deprecated because it is inefficient: it memoizes only
+temporarily instead of memoizing across all transformations where INPUTS is
+the same.
+
+Rewrite P, which is assumed to use GNU-BUILD-SYSTEM2, to take INPUTS and
+NATIVE-INPUTS as explicit inputs instead of the implicit default, and return
+it. INPUTS and NATIVE-INPUTS can be either input lists or thunks; in the
+latter case, they will be called in a context where the `%current-system' and
+`%current-target-system' are suitably parametrized. Use GUILE to run the
+builder, or the distro's final Guile when GUILE is #f."
+ (define inputs* inputs)
+ (define native-inputs* native-inputs)
+
+ (define (call inputs)
+ (if (procedure? inputs)
+ (inputs)
+ inputs))
+
+ (define (duplicate-filter inputs)
+ (let ((names (match (call inputs)
+ (((name _ ...) ...)
+ name))))
+ (lambda (inputs)
+ (fold alist-delete inputs names))))
+
+ (let loop ((p p))
+ (define rewritten-input
+ (mlambda (input)
+ (match input
+ ((name (? package? p) sub-drv ...)
+ ;; XXX: Check whether P's build system knows #:implicit-inputs, for
+ ;; things like `cross-pkg-config'.
+ (if (eq? (package-build-system p) gnu-build-system2)
+ (cons* name (loop p) sub-drv)
+ (cons* name p sub-drv)))
+ (x x))))
+
+ (package (inherit p)
+ (location (if (pair? loc) (source-properties->location loc) loc))
+ (arguments
+ ;; 'ensure-keyword-arguments' guarantees that this procedure is
+ ;; idempotent.
+ (ensure-keyword-arguments (package-arguments p)
+ `(#:guile ,guile
+ #:implicit-inputs? #f)))
+ (replacement
+ (let ((replacement (package-replacement p)))
+ (and replacement
+ (package-with-explicit-inputs2 replacement inputs loc
+ #:native-inputs
+ native-inputs
+ #:guile guile))))
+ (native-inputs
+ (let ((filtered (duplicate-filter native-inputs*)))
+ `(,@(call native-inputs*)
+ ,@(map rewritten-input
+ (filtered (package-native-inputs p))))))
+ (propagated-inputs
+ (map rewritten-input
+ (package-propagated-inputs p)))
+ (inputs
+ (let ((filtered (duplicate-filter inputs*)))
+ `(,@(call inputs*)
+ ,@(map rewritten-input
+ (filtered (package-inputs p)))))))))
+
+(define* (package-with-explicit-inputs* inputs #:optional guile)
+ "Return a procedure that rewrites the given package and all its dependencies
+so that they use INPUTS (a thunk) instead of implicit inputs."
+ (define (duplicate-filter package-inputs)
+ (let ((names (match (inputs)
+ (((name _ ...) ...)
+ name))))
+ (fold alist-delete package-inputs names)))
+
+ (define (add-explicit-inputs p)
+ (if (and (eq? (package-build-system p) gnu-build-system2)
+ (not (memq #:implicit-inputs? (package-arguments p))))
+ (package
+ (inherit p)
+ (inputs (append (inputs)
+ (duplicate-filter (package-inputs p))))
+ (arguments
+ (ensure-keyword-arguments (package-arguments p)
+ `(#:implicit-inputs? #f
+ #:guile ,guile))))
+ p))
+
+ (define (cut? p)
+ (or (not (eq? (package-build-system p) gnu-build-system2))
+ (memq #:implicit-inputs? (package-arguments p))))
+
+ (package-mapping add-explicit-inputs cut?))
+
+(define package-with-explicit-inputs2
+ (case-lambda*
+ ((inputs #:optional guile)
+ (package-with-explicit-inputs* inputs guile))
+ ((p inputs #:optional (loc (current-source-location))
+ #:key (native-inputs '()) guile)
+ ;; deprecated
+ (package-with-explicit-inputs/deprecated p inputs
+ loc
+ #:native-inputs
+ native-inputs
+ #:guile guile))))
+
+(define (package-with-extra-configure-variable2 p variable value)
+ "Return a version of P with VARIABLE=VALUE specified as an extra `configure'
+flag, recursively. An example is LDFLAGS=-static. If P already has configure
+flags for VARIABLE, the associated value is augmented."
+ (let loop ((p p))
+ (define (rewritten-inputs inputs)
+ (map (match-lambda
+ ((name (? package? p) sub ...)
+ `(,name ,(loop p) ,@sub))
+ (input input))
+ inputs))
+
+ (package (inherit p)
+ (arguments
+ (let ((args (package-arguments p)))
+ (substitute-keyword-arguments args
+ ((#:configure-flags flags)
+ (let* ((var= (string-append variable "="))
+ (len (string-length var=)))
+ `(cons ,(string-append var= value)
+ (map (lambda (flag)
+ (if (string-prefix? ,var= flag)
+ (string-append
+ ,(string-append var= value " ")
+ (substring flag ,len))
+ flag))
+ ,flags)))))))
+ (replacement
+ (let ((replacement (package-replacement p)))
+ (and replacement
+ (package-with-extra-configure-variable2 replacement
+ variable value))))
+ (inputs (rewritten-inputs (package-inputs p)))
+ (propagated-inputs (rewritten-inputs (package-propagated-inputs p))))))
+
+(define (static-libgcc-package2 p)
+ "A version of P linked with `-static-gcc'."
+ (package-with-extra-configure-variable2 p "LDFLAGS" "-static-libgcc"))
+
+(define* (static-package2 p #:key (strip-all? #t))
+ "Return a statically-linked version of package P. If STRIP-ALL? is true,
+use `--strip-all' as the arguments to `strip'."
+ (package (inherit p)
+ (arguments
+ (let ((a (default-keyword-arguments (package-arguments p)
+ '(#:configure-flags '()
+ #:strip-flags '("--strip-unneeded")))))
+ (substitute-keyword-arguments a
+ ((#:configure-flags flags)
+ `(cons* "--disable-shared" "LDFLAGS=-static" ,flags))
+ ((#:strip-flags flags)
+ (if strip-all?
+ ''("--strip-all")
+ flags)))))
+ (replacement (and=> (package-replacement p) static-package2))))
+
+(define* (dist-package2 p source #:key (phases '%dist-phases))
+ "Return a package that takes source files from the SOURCE directory,
+runs `make distcheck' and whose result is one or more source tarballs. The
+exact build phases are defined by PHASES."
+ (let ((s source))
+ (package (inherit p)
+ (name (string-append (package-name p) "-dist"))
+ (source s)
+ (arguments
+ ;; Use the right phases and modules.
+ (substitute-keyword-arguments (package-arguments p)
+ ((#:modules modules %default-modules)
+ `((guix build gnu-dist)
+ ,@modules))
+ ((#:imported-modules modules %gnu-build-system-modules2)
+ `((guix build gnu-dist)
+ ,@modules))
+ ((#:phases _ #f)
+ phases)))
+ (native-inputs
+ ;; Add autotools & co. as inputs.
+ (let ((ref (lambda (module var)
+ (module-ref (resolve-interface module) var))))
+ `(,@(package-native-inputs p)
+ ("autoconf" ,(ref '(gnu packages autotools) 'autoconf-wrapper))
+ ("automake" ,(ref '(gnu packages autotools) 'automake))
+ ("libtool" ,(ref '(gnu packages autotools) 'libtool))
+ ("gettext" ,(ref '(gnu packages gettext) 'gnu-gettext))
+ ("texinfo" ,(ref '(gnu packages texinfo) 'texinfo))))))))
+
+(define (package-with-restricted-references2 p refs)
+ "Return a package whose outputs are guaranteed to only refer to the packages
+listed in REFS."
+ (if (eq? (package-build-system p) gnu-build-system2) ; XXX: dirty
+ (package (inherit p)
+ (arguments `(#:allowed-references ,refs
+ ,@(package-arguments p))))
+ p))
+
+\f
+(define (standard-packages2)
+ "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
+standard packages used as implicit inputs of the gnu-build-system2."
+
+ ;; Resolve (gnu packages commencement) lazily to hide circular dependency.
+ (let ((distro (resolve-module '(gnu packages commencement))))
+ (module-ref distro '%final-inputs)))
+
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (implicit-inputs? #t) (implicit-cross-inputs? #t)
+ (strip-binaries? #t) system
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME from the given arguments."
+ (define private-keywords
+ `(#:inputs #:native-inputs #:outputs
+ #:implicit-inputs? #:implicit-cross-inputs?
+ ,@(if target '() '(#:target))))
+
+ (bag
+ (name name)
+ (system system) (target target)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@native-inputs
+
+ ;; When not cross-compiling, ensure implicit inputs come
+ ;; last. That way, libc headers come last, which allows
+ ;; #include_next to work correctly; see
+ ;; <https://bugs.gnu.org/30756>.
+ ,@(if target '() inputs)
+ ,@(if (and target implicit-cross-inputs?)
+ (standard-cross-packages2 target 'host)
+ '())
+ ,@(if implicit-inputs?
+ (standard-packages2)
+ '())))
+ (host-inputs (if target inputs '()))
+
+ ;; The cross-libc is really a target package, but for bootstrapping
+ ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
+ ;; native package, so it would end up using a "native" variant of
+ ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+ ;; would use a target variant (built with 'gnu-cross-build'.)
+ (target-inputs (if (and target implicit-cross-inputs?)
+ (standard-cross-packages2 target 'target)
+ '()))
+ (outputs (if strip-binaries?
+ outputs
+ (delete "debug" outputs)))
+ (build (if target gnu-cross-build gnu-build2))
+ (arguments (strip-keyword-arguments private-keywords arguments))))
+
+(define %license-file-regexp
+ ;; Regexp matching license files.
+ "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
+(define %bootstrap-scripts
+ ;; Typical names of Autotools "bootstrap" scripts.
+ #~%bootstrap-scripts)
+
+(define %strip-flags
+ #~'("--strip-unneeded" "--enable-deterministic-archives"))
+
+(define %strip-directories
+ #~'("lib" "lib64" "libexec" "bin" "sbin"))
+
+(define* (gnu-build2 name inputs
+ #:key
+ guile source
+ (outputs '("out"))
+ (search-paths '())
+ (bootstrap-scripts %bootstrap-scripts)
+ (configure-flags ''())
+ (make-flags ''())
+ (out-of-source? #f)
+ (tests? #t)
+ (test-target "check")
+ (parallel-build? #t)
+ (parallel-tests? #t)
+ (patch-shebangs? #t)
+ (strip-binaries? #t)
+ (strip-flags %strip-flags)
+ (strip-directories %strip-directories)
+ (validate-runpath? #t)
+ (make-dynamic-linker-cache? #t)
+ (license-file-regexp %license-file-regexp)
+ (phases '%standard-phases)
+ (locale "en_US.utf8")
+ (system (%current-system))
+ (build (nix-system->gnu-triplet system))
+ (imported-modules %gnu-build-system-modules2)
+ (modules %default-modules)
+ (substitutable? #t)
+ allowed-references
+ disallowed-references)
+ "Return a derivation called NAME that builds from tarball SOURCE, with
+input derivation INPUTS, using the usual procedure of the GNU Build
+System. The builder is run with GUILE, or with the distro's final Guile
+package if GUILE is #f or omitted.
+
+The builder is run in a context where MODULES are used; IMPORTED-MODULES
+specifies modules not provided by Guile itself that must be imported in
+the builder's environment, from the host. Note that we distinguish
+between both, because for Guile's own modules like (ice-9 foo), we want
+to use GUILE's own version of it, rather than import the user's one,
+which could lead to gratuitous input divergence.
+
+SUBSTITUTABLE? determines whether users may be able to use substitutes of the
+returned derivations, or whether they should always build it locally.
+
+ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
+are allowed to refer to."
+ (define builder
+ (with-imported-modules imported-modules
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
+
+ #$(with-build-variables inputs outputs
+ #~(gnu-build2 #:source #+source
+ #:system #$system
+ #:build #$build
+ #:outputs %outputs
+ #:inputs %build-inputs
+ #:search-paths '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:phases #$(if (pair? phases)
+ (sexp->gexp phases)
+ phases)
+ #:locale #$locale
+ #:bootstrap-scripts #$bootstrap-scripts
+ #:configure-flags #$(if (pair? configure-flags)
+ (sexp->gexp configure-flags)
+ configure-flags)
+ #:make-flags #$(if (pair? make-flags)
+ (sexp->gexp make-flags)
+ make-flags)
+ #:out-of-source? #$out-of-source?
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:patch-shebangs? #$patch-shebangs?
+ #:license-file-regexp #$license-file-regexp
+ #:strip-binaries? #$strip-binaries?
+ #:validate-runpath? #$validate-runpath?
+ #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
+ #:license-file-regexp #$license-file-regexp
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories)))))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ ;; Note: Always pass #:graft? #f. Without it, ALLOWED-REFERENCES &
+ ;; co. would be interpreted as referring to grafted packages.
+ (gexp->derivation name builder
+ #:system system
+ #:target #f
+ #:graft? #f
+ #:substitutable? substitutable?
+ #:allowed-references allowed-references
+ #:disallowed-references disallowed-references
+ #:guile-for-build guile)))
+
+\f
+;;;
+;;; Cross-compilation.
+;;;
+
+(define standard-cross-packages2
+ (mlambda (target kind)
+ "Return the list of name/package tuples to cross-build for TARGET. KIND
+is one of `host' or `target'."
+ (let* ((cross (resolve-interface '(gnu packages cross-base)))
+ (gcc (module-ref cross 'cross-gcc))
+ (binutils (module-ref cross 'cross-binutils))
+ (libc (module-ref cross 'cross-libc)))
+ (case kind
+ ((host)
+ ;; Cross-GCC appears once here, so that it's in $PATH...
+ `(("cross-gcc" ,(gcc target
+ #:xbinutils (binutils target)
+ #:libc (libc target)))
+ ("cross-binutils" ,(binutils target))))
+ ((target)
+ (let ((libc (libc target)))
+ ;; ... and once here, so that libstdc++ & co. are in
+ ;; CROSS_CPLUS_INCLUDE_PATH, etc.
+ `(("cross-gcc" ,(gcc target
+ #:xbinutils (binutils target)
+ #:libc libc))
+ ("cross-libc" ,libc)
+
+ ;; MinGW's libc doesn't have a "static" output.
+ ,@(if (member "static" (package-outputs libc))
+ `(("cross-libc:static" ,libc "static"))
+ '()))))))))
+
+(define* (gnu-cross-build name
+ #:key
+ target
+ build-inputs target-inputs host-inputs
+ guile source
+ (outputs '("out"))
+ (search-paths '())
+ (native-search-paths '())
+
+ (bootstrap-scripts %bootstrap-scripts)
+ (configure-flags ''())
+ (make-flags ''())
+ (out-of-source? #f)
+ (tests? #f) ; nothing can be done
+ (test-target "check")
+ (parallel-build? #t) (parallel-tests? #t)
+ (patch-shebangs? #t)
+ (strip-binaries? #t)
+ (strip-flags %strip-flags)
+ (strip-directories %strip-directories)
+ (validate-runpath? #t)
+
+ ;; We run 'ldconfig' to generate ld.so.cache and it
+ ;; generally can't do that for cross-built binaries
+ ;; ("ldconfig: foo.so is for unknown machine 40.").
+ (make-dynamic-linker-cache? #f)
+
+ (license-file-regexp %license-file-regexp)
+ (phases '%standard-phases)
+ (locale "en_US.utf8")
+ (system (%current-system))
+ (build (nix-system->gnu-triplet system))
+ (imported-modules %gnu-build-system-modules2)
+ (modules %default-modules)
+ (substitutable? #t)
+ allowed-references
+ disallowed-references)
+ "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
+cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
+platform."
+ (define builder
+ #~(begin
+ (use-modules #$@(sexp->gexp modules))
+
+ (define %build-host-inputs
+ #+(input-tuples->gexp build-inputs))
+
+ (define %build-target-inputs
+ (append #$(input-tuples->gexp host-inputs)
+ #+(input-tuples->gexp target-inputs)))
+
+ (define %build-inputs
+ (append %build-host-inputs %build-target-inputs))
+
+ (define %outputs
+ #$(outputs->gexp outputs))
+
+ (gnu-build2 #:source #+source
+ #:system #$system
+ #:build #$build
+ #:target #$target
+ #:outputs %outputs
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths '#$(sexp->gexp
+ (map search-path-specification->sexp
+ search-paths))
+ #:native-search-paths '#$(sexp->gexp
+ (map
+ search-path-specification->sexp
+ native-search-paths))
+ #:phases #$(if (pair? phases)
+ (sexp->gexp phases)
+ phases)
+ #:locale #$locale
+ #:bootstrap-scripts #$bootstrap-scripts
+ #:configure-flags #$configure-flags
+ #:make-flags #$make-flags
+ #:out-of-source? #$out-of-source?
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:patch-shebangs? #$patch-shebangs?
+ #:license-file-regexp #$license-file-regexp
+ #:strip-binaries? #$strip-binaries?
+ #:validate-runpath? #$validate-runpath?
+ #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
+ #:license-file-regexp #$license-file-regexp
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories)))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:target target
+ #:graft? #f
+ #:modules imported-modules
+ #:substitutable? substitutable?
+ #:allowed-references allowed-references
+ #:disallowed-references disallowed-references
+ #:guile-for-build guile)))
+
+(define gnu-build-system2
+ (build-system
+ (name 'gnu)
+ (description
+ "The GNU Build System—i.e., ./configure && make && make install")
+ (lower lower)))
diff --git a/guix/build/gnu-build-system2.scm b/guix/build/gnu-build-system2.scm
new file mode 100644
index 0000000000..54129549c2
--- /dev/null
+++ b/guix/build/gnu-build-system2.scm
@@ -0,0 +1,937 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2020 Brendan Tildesley <mail@brendan.scot>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build gnu-build-system2)
+ #:use-module (guix build utils)
+ #:use-module (guix build gremlin)
+ #:use-module (guix elf)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 ftw)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-26)
+ #:use-module (rnrs io ports)
+ #:export (%standard-phases
+ %license-file-regexp
+ %bootstrap-scripts
+ dump-file-contents
+ gnu-build2))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install"). This is the
+;; builder-side code.
+;;
+;; Code:
+
+(cond-expand
+ (guile-2.2
+ ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
+ ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
+ (define time-monotonic time-tai))
+ (else #t))
+
+(define* (set-SOURCE-DATE-EPOCH #:rest _)
+ "Set the 'SOURCE_DATE_EPOCH' environment variable. This is used by tools
+that incorporate timestamps as a way to tell them to use a fixed timestamp.
+See https://reproducible-builds.org/specs/source-date-epoch/."
+ (setenv "SOURCE_DATE_EPOCH" "1"))
+
+(define (first-subdirectory directory)
+ "Return the file name of the first sub-directory of DIRECTORY or false, when
+there are none."
+ (match (scandir directory
+ (lambda (file)
+ (and (not (member file '("." "..")))
+ (file-is-directory? (string-append directory "/"
+ file)))))
+ ((first . _) first)
+ (_ #f)))
+
+(define* (set-paths #:key target inputs native-inputs
+ (search-paths '()) (native-search-paths '())
+ #:allow-other-keys)
+ (define input-directories
+ ;; The "source" input can be a directory, but we don't want it for search
+ ;; paths. See <https://issues.guix.gnu.org/44924>.
+ (match (alist-delete "source" inputs)
+ (((_ . dir) ...)
+ dir)))
+
+ (define native-input-directories
+ (match native-inputs
+ (((_ . dir) ...)
+ dir)
+ (#f ; not cross compiling
+ '())))
+
+ ;; Tell 'ld-wrapper' to disallow non-store libraries.
+ (setenv "GUIX_LD_WRAPPER_ALLOW_IMPURITIES" "no")
+
+ ;; When cross building, $PATH must refer only to native (host) inputs since
+ ;; target inputs are not executable.
+ (set-path-environment-variable "PATH" '("bin" "sbin")
+ (append native-input-directories
+ (if target
+ '()
+ input-directories)))
+
+ (for-each (match-lambda
+ ((env-var (files ...) separator type pattern)
+ (set-path-environment-variable env-var files
+ input-directories
+ #:separator separator
+ #:type type
+ #:pattern pattern)))
+ search-paths)
+
+ (when native-search-paths
+ ;; Search paths for native inputs, when cross building.
+ (for-each (match-lambda
+ ((env-var (files ...) separator type pattern)
+ (set-path-environment-variable env-var files
+ native-input-directories
+ #:separator separator
+ #:type type
+ #:pattern pattern)))
+ native-search-paths)))
+
+(define* (install-locale #:key
+ (locale "en_US.utf8")
+ (locale-category LC_ALL)
+ #:allow-other-keys)
+ "Try to install LOCALE; emit a warning if that fails. The main goal is to
+use a UTF-8 locale so that Guile correctly interprets UTF-8 file names.
+
+This phase must typically happen after 'set-paths' so that $LOCPATH has a
+chance to be set."
+ (catch 'system-error
+ (lambda ()
+ (setlocale locale-category locale)
+
+ ;; While we're at it, pass it to sub-processes.
+ (setenv (locale-category->string locale-category) locale)
+
+ (format (current-error-port) "using '~a' locale for category ~s~%"
+ locale (locale-category->string locale-category)))
+ (lambda args
+ ;; This is known to fail for instance in early bootstrap where locales
+ ;; are not available.
+ (format (current-error-port)
+ "warning: failed to install '~a' locale: ~a~%"
+ locale (strerror (system-error-errno args))))))
+
+(define* (unpack #:key source #:allow-other-keys)
+ "Unpack SOURCE in the working directory, and change directory within the
+source. When SOURCE is a directory, copy it in a sub-directory of the current
+working directory."
+ (if (file-is-directory? source)
+ (begin
+ (mkdir "source")
+ (chdir "source")
+
+ ;; Preserve timestamps (set to the Epoch) on the copied tree so that
+ ;; things work deterministically.
+ (copy-recursively source "."
+ #:keep-mtime? #t)
+ ;; Make the source checkout files writable, for convenience.
+ (for-each (lambda (f)
+ (false-if-exception (make-file-writable f)))
+ (find-files ".")))
+ (begin
+ (cond
+ ((string-suffix? ".zip" source)
+ (invoke "unzip" source))
+ ((tarball? source)
+ (invoke "tar" "xvf" source))
+ (else
+ (let ((name (strip-store-file-name source))
+ (command (compressor source)))
+ (copy-file source name)
+ (when command
+ (invoke command "--decompress" name)))))
+ ;; Attempt to change into child directory.
+ (and=> (first-subdirectory ".") chdir))))
+
+(define %bootstrap-scripts
+ ;; Typical names of Autotools "bootstrap" scripts.
+ '("bootstrap" "bootstrap.sh" "autogen.sh"))
+
+(define* (bootstrap #:key (bootstrap-scripts %bootstrap-scripts)
+ #:allow-other-keys)
+ "If the code uses Autotools and \"configure\" is missing, run
+\"autoreconf\". Otherwise do nothing."
+ ;; Note: Run that right after 'unpack' so that the generated files are
+ ;; visible when the 'patch-source-shebangs' phase runs.
+ (define (script-exists? file)
+ (and (file-exists? file)
+ (not (file-is-directory? file))))
+
+ (if (not (script-exists? "configure"))
+
+ ;; First try one of the BOOTSTRAP-SCRIPTS. If none exists, and it's
+ ;; clearly an Autoconf-based project, run 'autoreconf'. Otherwise, do
+ ;; nothing (perhaps the user removed or overrode the 'configure' phase.)
+ (let ((script (find script-exists? bootstrap-scripts)))
+ ;; GNU packages often invoke the 'git-version-gen' script from
+ ;; 'configure.ac' so make sure it has a valid shebang.
+ (false-if-file-not-found
+ (patch-shebang "build-aux/git-version-gen"))
+
+ (if script
+ (let ((script (string-append "./" script)))
+ (setenv "NOCONFIGURE" "true")
+ (format #t "running '~a'~%" script)
+ (if (executable-file? script)
+ (begin
+ (patch-shebang script)
+ (invoke script))
+ (invoke "sh" script))
+ ;; Let's clean up after ourselves.
+ (unsetenv "NOCONFIGURE"))
+ (if (or (file-exists? "configure.ac")
+ (file-exists? "configure.in"))
+ (invoke "autoreconf" "-vif")
+ (format #t "no 'configure.ac' or anything like that, \
+doing nothing~%"))))
+ (format #t "GNU build system bootstrapping not needed~%")))
+
+;; See <http://bugs.gnu.org/17840>.
+(define* (patch-usr-bin-file #:key native-inputs inputs
+ (patch-/usr/bin/file? #t)
+ #:allow-other-keys)
+ "Patch occurrences of \"/usr/bin/file\" in all the executable 'configure'
+files found in the source tree. This works around Libtool's Autoconf macros,
+which generates invocations of \"/usr/bin/file\" that are used to determine
+things like the ABI being used."
+ (when patch-/usr/bin/file?
+ (for-each (lambda (file)
+ (when (executable-file? file)
+ (patch-/usr/bin/file file)))
+ (find-files "." "^configure$"))))
+
+(define* (patch-source-shebangs #:key source #:allow-other-keys)
+ "Patch shebangs in all source files; this includes non-executable
+files such as `.in' templates. Most scripts honor $SHELL and
+$CONFIG_SHELL, but some don't, such as `mkinstalldirs' or Automake's
+`missing' script."
+ (for-each patch-shebang
+ (find-files "."
+ (lambda (file stat)
+ ;; Filter out symlinks.
+ (eq? 'regular (stat:type stat)))
+ #:stat lstat)))
+
+(define (patch-generated-file-shebangs . rest)
+ "Patch shebangs in generated files, including `SHELL' variables in
+makefiles."
+ ;; Patch executable regular files, some of which might have been generated
+ ;; by `configure'.
+ (for-each patch-shebang
+ (find-files "."
+ (lambda (file stat)
+ (and (eq? 'regular (stat:type stat))
+ (not (zero? (logand (stat:mode stat) #o100)))))
+ #:stat lstat))
+
+ ;; Patch `SHELL' in generated makefiles.
+ (for-each patch-makefile-SHELL (find-files "." "^(GNU)?[mM]akefile$")))
+
+(define* (configure #:key build target native-inputs inputs outputs
+ (configure-flags '()) out-of-source?
+ #:allow-other-keys)
+ (define (package-name)
+ (let* ((out (assoc-ref outputs "out"))
+ (base (basename out))
+ (dash (string-rindex base #\-)))
+ ;; XXX: We'd rather use `package-name->name+version' or similar.
+ (string-drop (if dash
+ (substring base 0 dash)
+ base)
+ (+ 1 (string-index base #\-)))))
+
+ (let* ((prefix (assoc-ref outputs "out"))
+ (bindir (assoc-ref outputs "bin"))
+ (libdir (assoc-ref outputs "lib"))
+ (includedir (assoc-ref outputs "include"))
+ (docdir (assoc-ref outputs "doc"))
+ (bash (or (and=> (assoc-ref (or native-inputs inputs) "bash")
+ (cut string-append <> "/bin/bash"))
+ "/bin/sh"))
+ (flags `(,@(if target ; cross building
+ '("CC_FOR_BUILD=gcc")
+ '())
+ ,(string-append "CONFIG_SHELL=" bash)
+ ,(string-append "SHELL=" bash)
+ ,(string-append "--prefix=" prefix)
+ "--enable-fast-install" ; when using Libtool
+
+ ;; Produce multiple outputs when specific output names
+ ;; are recognized.
+ ,@(if bindir
+ (list (string-append "--bindir=" bindir "/bin"))
+ '())
+ ,@(if libdir
+ (cons (string-append "--libdir=" libdir "/lib")
+ (if includedir
+ '()
+ (list
+ (string-append "--includedir="
+ libdir "/include"))))
+ '())
+ ,@(if includedir
+ (list (string-append "--includedir="
+ includedir "/include"))
+ '())
+ ,@(if docdir
+ (list (string-append "--docdir=" docdir
+ "/share/doc/" (package-name)))
+ '())
+ ,@(if build
+ (list (string-append "--build=" build))
+ '())
+ ,@(if target ; cross building
+ (list (string-append "--host=" target))
+ '())
+ ,@configure-flags))
+ (abs-srcdir (getcwd))
+ (srcdir (if out-of-source?
+ (string-append "../" (basename abs-srcdir))
+ ".")))
+ (format #t "source directory: ~s (relative from build: ~s)~%"
+ abs-srcdir srcdir)
+ (if out-of-source?
+ (begin
+ (mkdir "../build")
+ (chdir "../build")))
+ (format #t "build directory: ~s~%" (getcwd))
+ (format #t "configure flags: ~s~%" flags)
+
+ ;; Use BASH to reduce reliance on /bin/sh since it may not always be
+ ;; reliable (see
+ ;; <http://thread.gmane.org/gmane.linux.distributions.nixos/9748>
+ ;; for a summary of the situation.)
+ ;;
+ ;; Call `configure' with a relative path. Otherwise, GCC's build system
+ ;; (for instance) records absolute source file names, which typically
+ ;; contain the hash part of the `.drv' file, leading to a reference leak.
+ (apply invoke bash
+ (string-append srcdir "/configure")
+ flags)))
+
+(define* (build #:key (make-flags '()) (parallel-build? #t)
+ #:allow-other-keys)
+ (apply invoke "make"
+ `(,@(if parallel-build?
+ `("-j" ,(number->string (parallel-job-count)))
+ '())
+ ,@make-flags)))
+
+(define* (dump-file-contents directory file-regexp
+ #:optional (port (current-error-port)))
+ "Dump to PORT the contents of files in DIRECTORY that match FILE-REGEXP."
+ (define (dump file)
+ (let ((prefix (string-append "\n--- " file " ")))
+ (display (if (< (string-length prefix) 78)
+ (string-pad-right prefix 78 #\-)
+ prefix)
+ port)
+ (display "\n\n" port)
+ (call-with-input-file file
+ (lambda (log)
+ (dump-port log port)))
+ (display "\n" port)))
+
+ (for-each dump (find-files directory file-regexp)))
+
+(define %test-suite-log-regexp
+ ;; Name of test suite log files as commonly found in GNU-based build systems
+ ;; and CMake.
+ "^(test-?suite\\.log|LastTestFailed\\.log)$")
+
+(define* (check #:key target (make-flags '()) (tests? (not target))
+ (test-target "check") (parallel-tests? #t)
+ (test-suite-log-regexp %test-suite-log-regexp)
+ #:allow-other-keys)
+ (if tests?
+ (guard (c ((invoke-error? c)
+ ;; Dump the test suite log to facilitate debugging.
+ (display "\nTest suite failed, dumping logs.\n"
+ (current-error-port))
+ (dump-file-contents "." test-suite-log-regexp)
+ (raise c)))
+ (apply invoke "make" test-target
+ `(,@(if parallel-tests?
+ `("-j" ,(number->string (parallel-job-count)))
+ '())
+ ,@make-flags)))
+ (format #t "test suite not run~%")))
+
+(define* (install #:key (make-flags '()) #:allow-other-keys)
+ (apply invoke "make" "install" make-flags))
+
+(define* (patch-shebangs #:key inputs outputs (patch-shebangs? #t)
+ #:allow-other-keys)
+ (define (list-of-files dir)
+ (map (cut string-append dir "/" <>)
+ (or (scandir dir (lambda (f)
+ (let ((s (lstat (string-append dir "/" f))))
+ (eq? 'regular (stat:type s)))))
+ '())))
+
+ (define bin-directories
+ (match-lambda
+ ((_ . dir)
+ (list (string-append dir "/bin")
+ (string-append dir "/sbin")
+ (string-append dir "/libexec")))))
+
+ (define output-bindirs
+ (append-map bin-directories outputs))
+
+ (define input-bindirs
+ ;; Shebangs should refer to binaries of the target system---i.e., from
+ ;; "inputs", not from "native-inputs".
+ (append-map bin-directories inputs))
+
+ (when patch-shebangs?
+ (let ((path (append output-bindirs input-bindirs)))
+ (for-each (lambda (dir)
+ (let ((files (list-of-files dir)))
+ (for-each (cut patch-shebang <> path) files)))
+ output-bindirs))))
+
+(define* (strip #:key target outputs (strip-binaries? #t)
+ (strip-command (if target
+ (string-append target "-strip")
+ "strip"))
+ (objcopy-command (if target
+ (string-append target "-objcopy")
+ "objcopy"))
+ (strip-flags '("--strip-unneeded"
+ "--enable-deterministic-archives"))
+ (strip-directories '("lib" "lib64" "libexec"
+ "bin" "sbin"))
+ #:allow-other-keys)
+ (define debug-output
+ ;; If an output is called "debug", then that's where debugging information
+ ;; will be stored instead of being discarded.
+ (assoc-ref outputs "debug"))
+
+ (define debug-file-extension
+ ;; File name extension for debugging information.
+ ".debug")
+
+ (define (debug-file file)
+ ;; Return the name of the debug file for FILE, an absolute file name.
+ ;; Once installed in the user's profile, it is in $PROFILE/lib/debug/FILE,
+ ;; which is where GDB looks for it (info "(gdb) Separate Debug Files").
+ (string-append debug-output "/lib/debug/"
+ file debug-file-extension))
+
+ (define (make-debug-file file)
+ ;; Create a file in DEBUG-OUTPUT containing the debugging info of FILE.
+ (let ((debug (debug-file file)))
+ (mkdir-p (dirname debug))
+ (copy-file file debug)
+ (invoke strip-command "--only-keep-debug" debug)
+ (chmod debug #o400)))
+
+ (define (add-debug-link file)
+ ;; Add a debug link in FILE (info "(binutils) strip").
+
+ ;; `objcopy --add-gnu-debuglink' wants to have the target of the debug
+ ;; link around so it can compute a CRC of that file (see the
+ ;; `bfd_fill_in_gnu_debuglink_section' function.) No reference to
+ ;; DEBUG-OUTPUT is kept because bfd keeps only the basename of the debug
+ ;; file.
+ (invoke objcopy-command "--enable-deterministic-archives"
+ (string-append "--add-gnu-debuglink="
+ (debug-file file))
+ file))
+
+ (define (strip-dir dir)
+ (format #t "stripping binaries in ~s with ~s and flags ~s~%"
+ dir strip-command strip-flags)
+ (when debug-output
+ (format #t "debugging output written to ~s using ~s~%"
+ debug-output objcopy-command))
+
+ (for-each (lambda (file)
+ (when (or (elf-file? file) (ar-file? file))
+ ;; If an error occurs while processing a file, issue a
+ ;; warning and continue to the next file.
+ (guard (c ((invoke-error? c)
+ (format (current-error-port)
+ "warning: ~a: program ~s exited\
+~@[ with non-zero exit status ~a~]\
+~@[ terminated by signal ~a~]~%"
+ file
+ (invoke-error-program c)
+ (invoke-error-exit-status c)
+ (invoke-error-term-signal c))))
+ (when debug-output
+ (make-debug-file file))
+
+ ;; Ensure the file is writable.
+ (make-file-writable file)
+
+ (apply invoke strip-command
+ (append strip-flags (list file)))
+
+ (when debug-output
+ (add-debug-link file)))))
+ (find-files dir
+ (lambda (file stat)
+ ;; Ignore symlinks such as:
+ ;; libfoo.so -> libfoo.so.0.0.
+ (eq? 'regular (stat:type stat)))
+ #:stat lstat)))
+
+ (when strip-binaries?
+ (for-each
+ strip-dir
+ (append-map (match-lambda
+ ((_ . dir)
+ (filter-map (lambda (d)
+ (let ((sub (string-append dir "/" d)))
+ (and (directory-exists? sub) sub)))
+ strip-directories)))
+ outputs))))
+
+(define* (validate-runpath #:key
+ (validate-runpath? #t)
+ (elf-directories '("lib" "lib64" "libexec"
+ "bin" "sbin"))
+ outputs #:allow-other-keys)
+ "When VALIDATE-RUNPATH? is true, validate that all the ELF files in
+ELF-DIRECTORIES have their dependencies found in their 'RUNPATH'.
+
+Since the ELF parser needs to have a copy of files in memory, better run this
+phase after stripping."
+ (define (sub-directory parent)
+ (lambda (directory)
+ (let ((directory (string-append parent "/" directory)))
+ (and (directory-exists? directory) directory))))
+
+ (define (validate directory)
+ (define (file=? file1 file2)
+ (let ((st1 (stat file1))
+ (st2 (stat file2)))
+ (= (stat:ino st1) (stat:ino st2))))
+
+ ;; There are always symlinks from '.so' to '.so.1' and so on, so delete
+ ;; duplicates.
+ (let ((files (delete-duplicates (find-files directory (lambda (file stat)
+ (elf-file? file)))
+ file=?)))
+ (format (current-error-port)
+ "validating RUNPATH of ~a binaries in ~s...~%"
+ (length files) directory)
+ (every* validate-needed-in-runpath files)))
+
+ (if validate-runpath?
+ (let ((dirs (append-map (match-lambda
+ (("debug" . _)
+ ;; The "debug" output is full of ELF files
+ ;; that are not worth checking.
+ '())
+ ((name . output)
+ (filter-map (sub-directory output)
+ elf-directories)))
+ outputs)))
+ (unless (every* validate dirs)
+ (error "RUNPATH validation failed")))
+ (format (current-error-port) "skipping RUNPATH validation~%")))
+
+(define* (validate-documentation-location #:key outputs
+ #:allow-other-keys)
+ "Documentation should go to 'share/info' and 'share/man', not just 'info/'
+and 'man/'. This phase moves directories to the right place if needed."
+ (define (validate-sub-directory output sub-directory)
+ (let ((directory (string-append output "/" sub-directory)))
+ (when (directory-exists? directory)
+ (let ((target (string-append output "/share/" sub-directory)))
+ (format #t "moving '~a' to '~a'~%" directory target)
+ (mkdir-p (dirname target))
+ (rename-file directory target)))))
+
+ (define (validate-output output)
+ (for-each (cut validate-sub-directory output <>)
+ '("man" "info")))
+
+ (match outputs
+ (((names . directories) ...)
+ (for-each validate-output directories))))
+
+(define* (reset-gzip-timestamps #:key outputs #:allow-other-keys)
+ "Reset embedded timestamps in gzip files found in OUTPUTS."
+ (define (process-directory directory)
+ (let ((files (find-files directory
+ (lambda (file stat)
+ (and (eq? 'regular (stat:type stat))
+ (or (string-suffix? ".gz" file)
+ (string-suffix? ".tgz" file))
+ (gzip-file? file)))
+ #:stat lstat)))
+ ;; Ensure the files are writable.
+ (for-each make-file-writable files)
+ (for-each reset-gzip-timestamp files)))
+
+ (match outputs
+ (((names . directories) ...)
+ (for-each process-directory directories))))
+
+(define* (compress-documentation #:key outputs
+ (compress-documentation? #t)
+ (documentation-compressor "gzip")
+ (documentation-compressor-flags
+ '("--best" "--no-name"))
+ (compressed-documentation-extension ".gz")
+ #:allow-other-keys)
+ "When COMPRESS-DOCUMENTATION? is true, compress man pages and Info files
+found in OUTPUTS using DOCUMENTATION-COMPRESSOR, called with
+DOCUMENTATION-COMPRESSOR-FLAGS."
+ (define (retarget-symlink link)
+ (let ((target (readlink link)))
+ (delete-file link)
+ (symlink (string-append target compressed-documentation-extension)
+ (string-append link compressed-documentation-extension))))
+
+ (define (has-links? file)
+ ;; Return #t if FILE has hard links.
+ (> (stat:nlink (lstat file)) 1))
+
+ (define (points-to-symlink? symlink)
+ ;; Return #t if SYMLINK points to another symbolic link.
+ (let* ((target (readlink symlink))
+ (target-absolute (if (string-prefix? "/" target)
+ target
+ (string-append (dirname symlink)
+ "/" target))))
+ (catch 'system-error
+ (lambda ()
+ (symbolic-link? target-absolute))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ (begin
+ (format (current-error-port)
+ "The symbolic link '~a' target is missing: '~a'\n"
+ symlink target-absolute)
+ #f)
+ (apply throw args))))))
+
+ (define (maybe-compress-directory directory regexp)
+ (when (directory-exists? directory)
+ (match (find-files directory regexp)
+ (() ;nothing to compress
+ #t)
+ ((files ...) ;one or more files
+ (format #t
+ "compressing documentation in '~a' with ~s and flags ~s~%"
+ directory documentation-compressor
+ documentation-compressor-flags)
+ (call-with-values
+ (lambda ()
+ (partition symbolic-link? files))
+ (lambda (symlinks regular-files)
+ ;; Compress the non-symlink files, and adjust symlinks to refer
+ ;; to the compressed files. Leave files that have hard links
+ ;; unchanged ('gzip' would refuse to compress them anyway.)
+ ;; Also, do not retarget symbolic links pointing to other
+ ;; symbolic links, since these are not compressed.
+ (for-each retarget-symlink
+ (filter (lambda (symlink)
+ (and (not (points-to-symlink? symlink))
+ (string-match regexp symlink)))
+ symlinks))
+ (apply invoke documentation-compressor
+ (append documentation-compressor-flags
+ (remove has-links? regular-files)))))))))
+
+ (define (maybe-compress output)
+ (maybe-compress-directory (string-append output "/share/man")
+ "\\.[0-9]+$")
+ (maybe-compress-directory (string-append output "/share/info")
+ "\\.info(-[0-9]+)?$"))
+
+ (if compress-documentation?
+ (match outputs
+ (((names . directories) ...)
+ (for-each maybe-compress directories)))
+ (format #t "not compressing documentation~%")))
+
+(define* (delete-info-dir-file #:key outputs #:allow-other-keys)
+ "Delete any 'share/info/dir' file from OUTPUTS."
+ (for-each (match-lambda
+ ((output . directory)
+ (let ((info-dir-file (string-append directory "/share/info/dir")))
+ (when (file-exists? info-dir-file)
+ (delete-file info-dir-file)))))
+ outputs))
+
+
+(define* (patch-dot-desktop-files #:key outputs inputs #:allow-other-keys)
+ "Replace any references to executables in '.desktop' files with their
+absolute file names."
+ (define bin-directories
+ (append-map (match-lambda
+ ((_ . directory)
+ (list (string-append directory "/bin")
+ (string-append directory "/sbin"))))
+ outputs))
+
+ (define (which program)
+ (or (search-path bin-directories program)
+ (begin
+ (format (current-error-port)
+ "warning: '.desktop' file refers to '~a', \
+which cannot be found~%"
+ program)
+ program)))
+
+ (for-each (match-lambda
+ ((_ . directory)
+ (let ((applications (string-append directory
+ "/share/applications")))
+ (when (directory-exists? applications)
+ (let ((files (find-files applications "\\.desktop$")))
+ (format #t "adjusting ~a '.desktop' files in ~s~%"
+ (length files) applications)
+
+ ;; '.desktop' files contain translations and are always
+ ;; UTF-8-encoded.
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (substitute* files
+ (("^Exec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest)
+ (string-append "Exec=" (which binary) rest))
+ (("^TryExec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest)
+ (string-append "TryExec="
+ (which binary) rest)))))))))
+ outputs))
+
+(define* (make-dynamic-linker-cache #:key outputs
+ (make-dynamic-linker-cache? #t)
+ #:allow-other-keys)
+ "Create a dynamic linker cache under 'etc/ld.so.cache' in each of the
+OUTPUTS. This reduces application startup time by avoiding the 'stat' storm
+that traversing all the RUNPATH entries entails."
+ (define (make-cache-for-output directory)
+ (define bin-directories
+ (filter-map (lambda (sub-directory)
+ (let ((directory (string-append directory "/"
+ sub-directory)))
+ (and (directory-exists? directory)
+ directory)))
+ '("bin" "sbin" "libexec")))
+
+ (define programs
+ ;; Programs that can benefit from the ld.so cache.
+ (append-map (lambda (directory)
+ (if (directory-exists? directory)
+ (find-files directory
+ (lambda (file stat)
+ (and (executable-file? file)
+ (elf-file? file))))
+ '()))
+ bin-directories))
+
+ (define library-path
+ ;; Directories containing libraries that PROGRAMS depend on,
+ ;; recursively.
+ (delete-duplicates
+ (append-map (lambda (program)
+ (map dirname (file-needed/recursive program)))
+ programs)))
+
+ (define cache-file
+ (string-append directory "/etc/ld.so.cache"))
+
+ (define ld.so.conf
+ (string-append (or (getenv "TMPDIR") "/tmp")
+ "/ld.so.conf"))
+
+ (unless (null? library-path)
+ (mkdir-p (dirname cache-file))
+ (guard (c ((invoke-error? c)
+ ;; Do not treat 'ldconfig' failure as an error.
+ (format (current-error-port)
+ "warning: 'ldconfig' failed:~%")
+ (report-invoke-error c (current-error-port))))
+ ;; Create a config file to tell 'ldconfig' where to look for the
+ ;; libraries that PROGRAMS need.
+ (call-with-output-file ld.so.conf
+ (lambda (port)
+ (for-each (lambda (directory)
+ (display directory port)
+ (newline port))
+ library-path)))
+
+ (invoke "ldconfig" "-f" ld.so.conf "-C" cache-file)
+ (format #t "created '~a' from ~a library search path entries~%"
+ cache-file (length library-path)))))
+
+ (if make-dynamic-linker-cache?
+ (match outputs
+ (((_ . directories) ...)
+ (for-each make-cache-for-output directories)))
+ (format #t "ld.so cache not built~%")))
+
+(define %license-file-regexp
+ ;; Regexp matching license files.
+ "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
+(define* (install-license-files #:key outputs
+ (license-file-regexp %license-file-regexp)
+ out-of-source?
+ #:allow-other-keys)
+ "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'."
+ (define (find-source-directory package)
+ ;; For an out-of-source build, guess the source directory location
+ ;; relative to the current directory. Return #f on failure.
+ (match (scandir ".."
+ (lambda (file)
+ (and (not (member file '("." ".." "build")))
+ (file-is-directory?
+ (string-append "../" file)))))
+ (() ;hmm, no source
+ #f)
+ ((source) ;only one other file
+ (string-append "../" source))
+ ((directories ...) ;pick the most likely one
+ ;; This happens for example with libstdc++, which lives within the GCC
+ ;; source tree.
+ (any (lambda (directory)
+ (and (string-prefix? package directory)
+ (string-append "../" directory)))
+ directories))))
+
+ (define (copy-to-directories directories sub-directory)
+ (lambda (file)
+ (for-each (if (file-is-directory? file)
+ (cut copy-recursively file <>)
+ (cut install-file file <>))
+ (map (cut string-append <> "/" sub-directory)
+ directories))))
+
+ (let* ((regexp (make-regexp license-file-regexp))
+ (out (or (assoc-ref outputs "out")
+ (match outputs
+ (((_ . output) _ ...)
+ output))))
+ (package (strip-store-file-name out))
+ (outputs (match outputs
+ (((_ . outputs) ...)
+ outputs)))
+ (source (if out-of-source?
+ (find-source-directory
+ (package-name->name+version package))
+ "."))
+ (files (and source
+ (scandir source
+ (lambda (file)
+ (regexp-exec regexp file))))))
+ (if files
+ (begin
+ (format #t "installing ~a license files from '~a'~%"
+ (length files) source)
+ (for-each (copy-to-directories outputs
+ (string-append "share/doc/"
+ package))
+ (map (cut string-append source "/" <>) files)))
+ (format (current-error-port)
+ "failed to find license files~%"))))
+
+(define %standard-phases
+ ;; Standard build phases, as a list of symbol/procedure pairs.
+ (let-syntax ((phases (syntax-rules ()
+ ((_ p ...) `((p . ,p) ...)))))
+ (phases set-SOURCE-DATE-EPOCH set-paths install-locale unpack
+ bootstrap
+ patch-usr-bin-file
+ patch-source-shebangs configure patch-generated-file-shebangs
+ build check install
+ patch-shebangs strip
+ validate-runpath
+ validate-documentation-location
+ delete-info-dir-file
+ patch-dot-desktop-files
+ make-dynamic-linker-cache
+ install-license-files
+ reset-gzip-timestamps
+ compress-documentation)))
+
+\f
+(define* (gnu-build2 #:key (source #f) (outputs #f) (inputs #f)
+ (phases %standard-phases)
+ #:allow-other-keys
+ #:rest args)
+ "Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
+in order. Return #t if all the PHASES succeeded, #f otherwise."
+ (define (elapsed-time end start)
+ (let ((diff (time-difference end start)))
+ (+ (time-second diff)
+ (/ (time-nanosecond diff) 1e9))))
+
+ (setvbuf (current-output-port) 'line)
+ (setvbuf (current-error-port) 'line)
+
+ ;; Encoding/decoding errors shouldn't be silent.
+ (fluid-set! %default-port-conversion-strategy 'error)
+
+ (guard (c ((invoke-error? c)
+ (report-invoke-error c)
+ (exit 1)))
+ ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
+ ;; PHASES can pick the keyword arguments it's interested in.
+ (for-each (match-lambda
+ ((name . proc)
+ (let ((start (current-time time-monotonic)))
+ (define (end-of-phase success?)
+ (let ((end (current-time time-monotonic)))
+ (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
+ name success?
+ (elapsed-time end start))
+
+ ;; Dump the environment variables as a shell script,
+ ;; for handy debugging.
+ (system "export > $NIX_BUILD_TOP/environment-variables")))
+
+ (format #t "starting phase `~a'~%" name)
+ (with-throw-handler #t
+ (lambda ()
+ (apply proc args)
+ (end-of-phase #t))
+ (lambda args
+ ;; This handler executes before the stack is unwound.
+ ;; The exception is automatically re-thrown from here,
+ ;; and we should get a proper backtrace.
+ (format (current-error-port)
+ "error: in phase '~a': uncaught exception:
+~{~s ~}~%" name args)
+ (end-of-phase #f))))))
+ phases)))
base-commit: e2bcd41ce35b051f311e36dfd104d36ce1145f8b
prerequisite-patch-id: 77c51f63cfaba6cafe4e7125f50077d6dc5ca24a
prerequisite-patch-id: 776778c03bce9b7ad3ab94a120f42b764c00fcae
prerequisite-patch-id: 4910d08bdc27384d76030b6ac491ad2c2ed0957f
prerequisite-patch-id: 2de8762a6381a93682d0fe4c893962b9803362b0
prerequisite-patch-id: b9b6f21a2db3f7a5ef82bb11ed23f69749cc6b3d
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 2/6] build: gnu-build-system2: Remove source from native inputs.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 3/6] build-systems: gnu: Infer cross-toolchain from native-inputs components Maxim Cournoyer
` (4 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
Fixes <https://issues.guix.gnu.org/44924>, in a cross-compilation context.
Having the source in inputs when computing search paths can break builds. One
example is a git checkout of the Linux source tree, where the source (a
directory) 'include' subdirectory gets picked up in C_INCLUDE_PATH and causes
conflicts with the includes provided by glibc.
* guix/build/gnu-build-system2.scm (set-paths): Remove any "source" native
input.
---
guix/build/gnu-build-system2.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/guix/build/gnu-build-system2.scm b/guix/build/gnu-build-system2.scm
index 54129549c2..1766f9d474 100644
--- a/guix/build/gnu-build-system2.scm
+++ b/guix/build/gnu-build-system2.scm
@@ -83,10 +83,12 @@ (define input-directories
dir)))
(define native-input-directories
- (match native-inputs
+ ;; When cross-compiling, the source appears in native-inputs rather than
+ ;; inputs.
+ (match (and=> native-inputs (cut alist-delete "source" <>))
(((_ . dir) ...)
dir)
- (#f ; not cross compiling
+ (#f ;not cross-compiling
'())))
;; Tell 'ld-wrapper' to disallow non-store libraries.
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 3/6] build-systems: gnu: Infer cross-toolchain from native-inputs components.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 2/6] build: gnu-build-system2: Remove source from native inputs Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 4/6] gnu: glibc-2.30: Use gnu-build-system2 to fix cross-compiled build Maxim Cournoyer
` (3 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
This enables a user to override the base components used to build the cross
toolchain, which allows for example to use an older version of GCC.
* guix/build-system/gnu.scm (standard-cross-packages): New GCC, BINUTILS,
LIBC and LINUX-LIBRE-HEADERS keyword arguments. Update doc. Rename
implementation to...
(%standard-cross-packages): ... this procedure, which is extended to support
the above new arguments. Compute the cross toolchain components taking these
arguments into account.
(lower): Apply the GCC, BINUTILS, LIBC, and LINUX-LIBRE-HEADERS packages found
in the native inputs to standard-cross-packages, when available.
---
guix/build-system/gnu2.scm | 111 +++++++++++++++++++++++++++----------
1 file changed, 83 insertions(+), 28 deletions(-)
diff --git a/guix/build-system/gnu2.scm b/guix/build-system/gnu2.scm
index 95fce76714..5b0780d315 100644
--- a/guix/build-system/gnu2.scm
+++ b/guix/build-system/gnu2.scm
@@ -68,7 +68,7 @@ (define* (package-with-explicit-inputs/deprecated p inputs
temporarily instead of memoizing across all transformations where INPUTS is
the same.
-Rewrite P, which is assumed to use GNU-BUILD-SYSTEM2, to take INPUTS and
+Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take INPUTS and
NATIVE-INPUTS as explicit inputs instead of the implicit default, and return
it. INPUTS and NATIVE-INPUTS can be either input lists or thunks; in the
latter case, they will be called in a context where the `%current-system' and
@@ -287,9 +287,21 @@ (define private-keywords
#:implicit-inputs? #:implicit-cross-inputs?
,@(if target '() '(#:target))))
+ (define standard-cross-packages-args
+ ;; Since the packages used to customize the toolchain are intended to be
+ ;; provided manually at the package level, their actual package *name*
+ ;; must be expected, e.g. "glibc" rather than "libc".
+ (list #:gcc (and=> (assoc-ref native-inputs "gcc") car)
+ #:binutils (and=> (assoc-ref native-inputs "binutils") car)
+ #:libc (and=> (assoc-ref native-inputs "glibc") car)
+ #:linux-libre-headers
+ (and=> (assoc-ref native-inputs
+ "linux-libre-headers") car)))
+
(bag
(name name)
- (system system) (target target)
+ (system system)
+ (target target)
(build-inputs `(,@(if source
`(("source" ,source))
'())
@@ -301,7 +313,8 @@ (define private-keywords
;; <https://bugs.gnu.org/30756>.
,@(if target '() inputs)
,@(if (and target implicit-cross-inputs?)
- (standard-cross-packages2 target 'host)
+ (apply standard-cross-packages2
+ target 'host standard-cross-packages-args)
'())
,@(if implicit-inputs?
(standard-packages2)
@@ -314,7 +327,8 @@ (define private-keywords
;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
;; would use a target variant (built with 'gnu-cross-build'.)
(target-inputs (if (and target implicit-cross-inputs?)
- (standard-cross-packages2 target 'target)
+ (apply standard-cross-packages2
+ target 'target standard-cross-packages-args)
'()))
(outputs (if strip-binaries?
outputs
@@ -439,34 +453,75 @@ (define builder
;;; Cross-compilation.
;;;
-(define standard-cross-packages2
- (mlambda (target kind)
- "Return the list of name/package tuples to cross-build for TARGET. KIND
-is one of `host' or `target'."
- (let* ((cross (resolve-interface '(gnu packages cross-base)))
- (gcc (module-ref cross 'cross-gcc))
- (binutils (module-ref cross 'cross-binutils))
- (libc (module-ref cross 'cross-libc)))
+(define* (standard-cross-packages2 target kind
+ #:key gcc binutils libc linux-libre-headers)
+ "Return the list of name/package tuples to cross-build for TARGET. KIND is
+one of `host' or `target'. GCC, BINUTILS, LIBC and LINUX-LIBRE-HEADERS are
+the packages to use to build the cross toolchain. Unless specified, the
+defaults of the CROSS-GCC, CROSS-BINUTILS, CROSS-LIBC and CROSS-KERNEL-HEADERS
+procedures from (gnu packages cross-base) are used."
+ (%standard-cross-packages2 target kind gcc binutils libc linux-libre-headers))
+
+(define %standard-cross-packages2
+ (mlambda (target kind gcc binutils libc linux-libre-headers)
+ (let* ((cross-base (resolve-interface '(gnu packages cross-base)))
+ (cross-gcc (module-ref cross-base 'cross-gcc))
+ (cross-binutils (module-ref cross-base 'cross-binutils))
+ (cross-libc (module-ref cross-base 'cross-libc))
+ (cross-kernel-headers (module-ref cross-base 'cross-kernel-headers))
+ (xbinutils (if binutils
+ (cross-binutils target #:binutils binutils)
+ (cross-binutils target)))
+ (cross-gcc-args/no-libc `(,target
+ ,@(if gcc
+ `(#:xgcc ,gcc)
+ '())
+ ,@(if binutils
+ `(#:xbinutils ,xbinutils)
+ '())))
+ (xgcc/no-libc (apply cross-gcc cross-gcc-args/no-libc))
+ (cross-libc-args `(,target
+ ,@(if libc
+ `(#:libc ,libc)
+ '())
+ ,@(if gcc
+ `(#:xgcc ,xgcc/no-libc)
+ '())
+ ,@(if binutils
+ `(#:xbinutils ,xbinutils)
+ '())
+ ,@(if linux-libre-headers
+ `(#:xheaders
+ ,(apply cross-kernel-headers
+ `(,target
+ ,@(if linux-libre-headers
+ `(#:linux-headers
+ ,linux-libre-headers))
+ ,@(if gcc
+ `(#:xgcc ,xgcc/no-libc)
+ '())
+ ,@(if binutils
+ `(#:xbinutils ,xbinutils)
+ '()))))
+ '())))
+ (xlibc (apply cross-libc cross-libc-args))
+ (xgcc (apply cross-gcc
+ `(,@cross-gcc-args/no-libc #:libc ,xlibc))))
(case kind
((host)
;; Cross-GCC appears once here, so that it's in $PATH...
- `(("cross-gcc" ,(gcc target
- #:xbinutils (binutils target)
- #:libc (libc target)))
- ("cross-binutils" ,(binutils target))))
+ `(("cross-gcc" ,xgcc)
+ ("cross-binutils" ,xbinutils)))
((target)
- (let ((libc (libc target)))
- ;; ... and once here, so that libstdc++ & co. are in
- ;; CROSS_CPLUS_INCLUDE_PATH, etc.
- `(("cross-gcc" ,(gcc target
- #:xbinutils (binutils target)
- #:libc libc))
- ("cross-libc" ,libc)
-
- ;; MinGW's libc doesn't have a "static" output.
- ,@(if (member "static" (package-outputs libc))
- `(("cross-libc:static" ,libc "static"))
- '()))))))))
+ ;; ... and once here, so that libstdc++ & co. are in
+ ;; CROSS_CPLUS_INCLUDE_PATH, etc.
+ `(("cross-gcc" ,xgcc)
+ ("cross-libc" ,xlibc)
+
+ ;; MinGW's libc doesn't have a "static" output.
+ ,@(if (member "static" (package-outputs xlibc))
+ `(("cross-libc:static" ,xlibc "static"))
+ '())))))))
(define* (gnu-cross-build name
#:key
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 4/6] gnu: glibc-2.30: Use gnu-build-system2 to fix cross-compiled build.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 2/6] build: gnu-build-system2: Remove source from native inputs Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 3/6] build-systems: gnu: Infer cross-toolchain from native-inputs components Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 5/6] gnu: make-linux-libre*: Use gnu-build-system2 to fix cross compilation Maxim Cournoyer
` (2 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
* gnu/packages/base.scm (glibc-2.30) [build-system]: Use gnu-build-system2.
---
gnu/packages/base.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 36b27a4e25..b8b0ea241f 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -67,6 +67,7 @@ (define-module (gnu packages base)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
+ #:use-module ((guix build-system gnu2) #:select (gnu-build-system2))
#:use-module (guix build-system trivial)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@@ -1083,6 +1084,7 @@ (define-public glibc-2.30
(package
(inherit glibc-2.31)
(version "2.30")
+ (build-system gnu-build-system2)
(native-inputs
;; This fails with a build error in libc-tls.c when using GCC 10. Use an
;; older compiler.
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 5/6] gnu: make-linux-libre*: Use gnu-build-system2 to fix cross compilation.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
` (2 preceding siblings ...)
2022-12-15 3:23 ` bug#60056: [PATCH RFC 4/6] gnu: glibc-2.30: Use gnu-build-system2 to fix cross-compiled build Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 6/6] gnu: u-boot: Fix cross-compilation by using gnu-build-system2 Maxim Cournoyer
2022-12-15 15:09 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Ludovic Courtès
5 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
* gnu/packages/linux.scm (make-linux-libre*): Use gnu-build-system2.
---
gnu/packages/linux.scm | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index e0129ac9de..f80c9d26d7 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -174,6 +174,7 @@ (define-module (gnu packages linux)
#:use-module (guix build-system cmake)
#:use-module (guix build-system copy)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system gnu2)
#:use-module (guix build-system go)
#:use-module (guix build-system meson)
#:use-module (guix build-system python)
@@ -929,10 +930,10 @@ (define* (make-linux-libre* version gnu-revision source supported-systems
(version version)
(source source)
(supported-systems supported-systems)
- (build-system gnu-build-system)
+ (build-system gnu-build-system2)
(arguments
(list
- #:modules '((guix build gnu-build-system)
+ #:modules '((guix build gnu-build-system2)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26)
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 6/6] gnu: u-boot: Fix cross-compilation by using gnu-build-system2.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
` (3 preceding siblings ...)
2022-12-15 3:23 ` bug#60056: [PATCH RFC 5/6] gnu: make-linux-libre*: Use gnu-build-system2 to fix cross compilation Maxim Cournoyer
@ 2022-12-15 3:23 ` Maxim Cournoyer
2022-12-15 15:09 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Ludovic Courtès
5 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-15 3:23 UTC (permalink / raw)
To: 60056; +Cc: Maxim Cournoyer, ludo
* gnu/packages/bootloaders.scm (make-u-boot-package) [build-system]: Use
gnu-build-system2.
---
gnu/packages/bootloaders.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 32625bb799..f4c1cb729c 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -69,6 +69,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system gnu2)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -811,18 +812,19 @@ (define*-public (make-u-boot-package board triplet
`(("cross-gcc" ,(cross-gcc triplet))
("cross-binutils" ,(cross-binutils triplet)))
`())))
+ (build-system gnu-build-system2)
(arguments
(substitute-keyword-arguments (package-arguments u-boot)
((#:modules modules '())
`((ice-9 ftw)
(srfi srfi-1)
- (guix build gnu-build-system)
+ (guix build gnu-build-system2)
(guix build kconfig)
(guix build utils)
,@modules))
((#:imported-modules imported-modules '())
`((guix build kconfig)
- ,@%gnu-build-system-modules
+ ,@%gnu-build-system-modules2
,@imported-modules))
((#:test-target _ "test")
"test")
--
2.38.1
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2.
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
` (4 preceding siblings ...)
2022-12-15 3:23 ` bug#60056: [PATCH RFC 6/6] gnu: u-boot: Fix cross-compilation by using gnu-build-system2 Maxim Cournoyer
@ 2022-12-15 15:09 ` Ludovic Courtès
2022-12-16 4:56 ` Maxim Cournoyer
5 siblings, 1 reply; 11+ messages in thread
From: Ludovic Courtès @ 2022-12-15 15:09 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 60056
Hi!
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> * guix/build/gnu-build-system2.scm: New file.
> * Makefile.am (MODULES): Register it.
> * guix/build-system/gnu2.scm: Use it.
I won’t be able to review it in the coming days; a quick note:
• Changes to ‘gnu-build-system’ need thorough review, so don’t
hesitate to ping me and others in the “core” team if nothing comes
up, but don’t interpret silence as consent.
• I’m reluctant to duplicating ‘gnu-build-system’, even if it’s
temporary. I think now’s the right time for changes in
‘core-updates’ so we could make those changes there instead.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2.
2022-12-15 15:09 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Ludovic Courtès
@ 2022-12-16 4:56 ` Maxim Cournoyer
2022-12-17 11:53 ` zimoun
0 siblings, 1 reply; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-16 4:56 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 60056
Hi Ludovic,
Ludovic Courtès <ludo@gnu.org> writes:
> Hi!
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> * guix/build/gnu-build-system2.scm: New file.
>> * Makefile.am (MODULES): Register it.
>> * guix/build-system/gnu2.scm: Use it.
>
> I won’t be able to review it in the coming days; a quick note:
>
> • Changes to ‘gnu-build-system’ need thorough review, so don’t
> hesitate to ping me and others in the “core” team if nothing comes
> up, but don’t interpret silence as consent.
OK. I've used the etc/teams.scm script output to CC the core team
members. Hopefully it helped to ping them (did it for you?).
> • I’m reluctant to duplicating ‘gnu-build-system’, even if it’s
> temporary. I think now’s the right time for changes in
> ‘core-updates’ so we could make those changes there instead.
Yes, this is somewhat of a draft to allow people to test on master,
which lowers the cost (of building stuff). If and when we decide to go
forward with it, I'll make the change to gnu-build-system directly on
core-updates.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2.
2022-12-16 4:56 ` Maxim Cournoyer
@ 2022-12-17 11:53 ` zimoun
2022-12-17 15:58 ` Maxim Cournoyer
0 siblings, 1 reply; 11+ messages in thread
From: zimoun @ 2022-12-17 11:53 UTC (permalink / raw)
To: Maxim Cournoyer, Ludovic Courtès; +Cc: 60056
Hi Maxim,
On Thu, 15 Dec 2022 at 23:56, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
> OK. I've used the etc/teams.scm script output to CC the core team
> members. Hopefully it helped to ping them (did it for you?).
Maybe something is wrong with my config, but I am not able to find these
messages where I am CC.
Well, it is holidays in France (yeah, we have a lot ;-)) so I will not
be able to give a look before January – although, I am not convinced
that my comments would be useful.
Cheers,
simon
^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2.
2022-12-17 11:53 ` zimoun
@ 2022-12-17 15:58 ` Maxim Cournoyer
0 siblings, 0 replies; 11+ messages in thread
From: Maxim Cournoyer @ 2022-12-17 15:58 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, 60056
Hi Simon,
zimoun <zimon.toutoune@gmail.com> writes:
> Hi Maxim,
>
> On Thu, 15 Dec 2022 at 23:56, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
>
>> OK. I've used the etc/teams.scm script output to CC the core team
>> members. Hopefully it helped to ping them (did it for you?).
>
> Maybe something is wrong with my config, but I am not able to find these
> messages where I am CC.
I think if you are already registered to the list, adding 'X-Debbugs-Cc'
doesn't do more. It's only useful for people not already subscribed to
the list, I think.
At least to my filter configuration which uses the 'Return-Path: '
formed by mailmain, it'd be more useful if our etc/teams.scm script
simply used '--cc=', as it would then reach my INBOX rather than go in
my filtered directory.
> Well, it is holidays in France (yeah, we have a lot ;-)) so I will not
> be able to give a look before January – although, I am not convinced
> that my comments would be useful.
Any comments is better than none! But I'll give this some extra time
than the 2 weeks, because I know many people will not be available to
look at it and it's a core change (as mentioned by Ludovic earlier).
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 11+ messages in thread
end of thread, other threads:[~2022-12-17 16:00 UTC | newest]
Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-12-14 2:16 bug#60056: cross-compilation doesn't honor gcc native input Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 2/6] build: gnu-build-system2: Remove source from native inputs Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 3/6] build-systems: gnu: Infer cross-toolchain from native-inputs components Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 4/6] gnu: glibc-2.30: Use gnu-build-system2 to fix cross-compiled build Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 5/6] gnu: make-linux-libre*: Use gnu-build-system2 to fix cross compilation Maxim Cournoyer
2022-12-15 3:23 ` bug#60056: [PATCH RFC 6/6] gnu: u-boot: Fix cross-compilation by using gnu-build-system2 Maxim Cournoyer
2022-12-15 15:09 ` bug#60056: [PATCH RFC 1/6] build: Add gnu-build-system v2 Ludovic Courtès
2022-12-16 4:56 ` Maxim Cournoyer
2022-12-17 11:53 ` zimoun
2022-12-17 15:58 ` Maxim Cournoyer
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).