Toggle diff (285 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 38a8e5d4a6..c955041c61 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9338,6 +9338,44 @@ must be compatible. If @var{replacement} is somehow incompatible with
@var{package}, then the resulting package may be unusable. Use with
care!
+@cindex tool chain, changing the build tool chain of a package
+@item --with-c-toolchain=@var{package}=@var{toolchain}
+This option changes the compilation of @var{package} and everything that
+depends on it so that they get built with @var{toolchain} instead of the
+default GNU tool chain for C/C++.
+
+Consider this example:
+
+@example
+guix build octave-cli \
+ --with-c-toolchain=fftw=gcc-toolchain@@10 \
+ --with-c-toolchain=fftwf=gcc-toolchain@@10
+@end example
+
+The command above builds a variant of the @code{fftw} and @code{fftwf}
+packages using version 10 of @code{gcc-toolchain} instead of the default
+tool chain, and then builds a variant of the GNU@tie{}Octave
+command-line interface using them. GNU@tie{}Octave itself is also built
+with @code{gcc-toolchain@@10}.
+
+This other example builds the Hardware Locality (@code{hwloc}) library
+and its dependents up to @code{intel-mpi-benchmarks} with the Clang C
+compiler:
+
+@example
+guix build --with-c-toolchain=hwloc=clang-toolchain \
+ intel-mpi-benchmarks
+@end example
+
+@quotation Note
+There can be application binary interface (ABI) incompatibilities among
+tool chains. This is particularly true of the C++ standard library and
+run-time support libraries such as that of OpenMP. By rebuilding all
+dependents with the same tool chain, @option{--with-c-toolchain} minimizes
+the risks of incompatibility but cannot entirely eliminate them. Choose
+@var{package} wisely.
+@end quotation
+
@item --with-git-url=@var{package}=@var{url}
@cindex Git, using the latest commit
@cindex latest commit, building
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 72a5d46347..e59e0ee67f 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -26,6 +26,7 @@
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
+ #:use-module (guix memoization)
#:use-module (guix grafts)
#:use-module (guix utils)
@@ -396,6 +397,83 @@ a checkout of the Git repository at the given URL."
(rewrite obj)
obj)))
+(define (package-dependents/spec top bottom)
+ "Return the list of dependents of BOTTOM, a spec string, that are also
+dependencies of TOP, a package."
+ (define-values (name version)
+ (package-name->name+version bottom))
+
+ (define dependent?
+ (mlambda (p)
+ (and (package? p)
+ (or (and (string=? name (package-name p))
+ (or (not version)
+ (version-prefix? version (package-version p))))
+ (match (bag-direct-inputs (package->bag p))
+ (((labels dependencies . _) ...)
+ (any dependent? dependencies)))))))
+
+ (filter dependent? (package-closure (list top))))
+
+(define (package-toolchain-rewriting p bottom toolchain)
+ "Return a procedure that, when passed a package that's either BOTTOM or one
+of its dependents up to P so, changes it so it is built with TOOLCHAIN.
+TOOLCHAIN must be an input list."
+ (define rewriting-property
+ (gensym " package-toolchain-rewriting"))
+
+ (match (package-dependents/spec p bottom)
+ (() ;P does not depend on BOTTOM
+ identity)
+ (set
+ ;; SET is the list of packages "between" P and BOTTOM (included) whose
+ ;; toolchain needs to be changed.
+ (package-mapping (lambda (p)
+ (if (or (assq rewriting-property
+ (package-properties p))
+ (not (memq p set)))
+ p
+ (let ((p (package-with-c-toolchain p toolchain)))
+ (package/inherit p
+ (properties `((,rewriting-property . #t)
+ ,@(package-properties p)))))))
+ (lambda (p)
+ (or (assq rewriting-property (package-properties p))
+ (not (memq p set))))
+ #:deep? #t))))
+
+(define (transform-package-toolchain replacement-specs)
+ "Return a procedure that, when passed a package, changes its toolchain or
+that of its dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is
+a list of strings like \"fftw=gcc-toolchain@10\" meaning that the package to
+the left of the equal sign must be built with the toolchain to the right of
+the equal sign."
+ (define split-on-commas
+ (cute string-tokenize <> (char-set-complement (char-set #\,))))
+
+ (define (specification->input spec)
+ (let ((package (specification->package spec)))
+ (list (package-name package) package)))
+
+ (define replacements
+ (map (lambda (spec)
+ (match (string-tokenize spec %not-equal)
+ ((spec (= split-on-commas toolchain))
+ (cons spec (map specification->input toolchain)))
+ (_
+ (leave (G_ "~a: invalid toolchain replacement specification~%")
+ spec))))
+ replacement-specs))
+
+ (lambda (store obj)
+ (if (package? obj)
+ (or (any (match-lambda
+ ((bottom . toolchain)
+ ((package-toolchain-rewriting obj bottom toolchain) obj)))
+ replacements)
+ obj)
+ obj)))
+
(define (transform-package-tests specs)
"Return a procedure that, when passed a package, sets #:tests? #f in its
'arguments' field."
@@ -426,6 +504,7 @@ a checkout of the Git repository at the given URL."
(with-branch . ,transform-package-source-branch)
(with-commit . ,transform-package-source-commit)
(with-git-url . ,transform-package-source-git-url)
+ (with-c-toolchain . ,transform-package-toolchain)
(without-tests . ,transform-package-tests)))
(define (transformation-procedure key)
@@ -455,6 +534,8 @@ a checkout of the Git repository at the given URL."
(parser 'with-commit))
(option '("with-git-url") #t #f
(parser 'with-git-url))
+ (option '("with-c-toolchain") #t #f
+ (parser 'with-c-toolchain))
(option '("without-tests") #t #f
(parser 'without-tests)))))
@@ -477,6 +558,9 @@ a checkout of the Git repository at the given URL."
(display (G_ "
--with-git-url=PACKAGE=URL
build PACKAGE from the repository at URL"))
+ (display (G_ "
+ --with-c-toolchain=PACKAGE=TOOLCHAIN
+ build PACKAGE and its dependents with TOOLCHAIN"))
(display (G_ "
--without-tests=PACKAGE
build PACKAGE without running its tests")))
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 5f91360953..6925374baa 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -22,6 +22,8 @@
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix git-download)
+ #:use-module (guix build-system)
+ #:use-module (guix build-system gnu)
#:use-module (guix scripts build)
#:use-module (guix ui)
#:use-module (guix utils)
@@ -30,6 +32,8 @@
#:use-module (gnu packages base)
#:use-module (gnu packages busybox)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
@@ -270,6 +274,80 @@
((("x" dep3))
(map package-source (list dep1 dep3))))))))))))
+(define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain"))
+ "Return true if P depends on TOOLCHAIN instead of the default tool chain."
+ (define toolchain-packages
+ '("gcc" "binutils" "glibc" "ld-wrapper"))
+
+ (define (package-name* obj)
+ (and (package? obj) (package-name obj)))
+
+ (match (bag-build-inputs (package->bag p))
+ (((_ (= package-name* packages) . _) ...)
+ (and (not (any (cut member <> packages) toolchain-packages))
+ (member toolchain packages)))))
+
+(test-assert "options->transformation, with-c-toolchain"
+ (let* ((dep0 (dummy-package "chbouib"
+ (build-system gnu-build-system)
+ (native-inputs `(("y" ,grep)))))
+ (dep1 (dummy-package "stuff"
+ (native-inputs `(("x" ,dep0)))))
+ (p (dummy-package "thingie"
+ (build-system gnu-build-system)
+ (inputs `(("foo" ,grep)
+ ("bar" ,dep1)))))
+ (t (options->transformation
+ '((with-c-toolchain . "chbouib=gcc-toolchain")))))
+ ;; Here we check that the transformation applies to DEP0 and all its
+ ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN
+ ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on.
+ (with-store store
+ (let ((new (t store p)))
+ (and (depends-on-toolchain? new "gcc-toolchain")
+ (match (bag-build-inputs (package->bag new))
+ ((("foo" dep0) ("bar" dep1) _ ...)
+ (and (depends-on-toolchain? dep1 "gcc-toolchain")
+ (not (depends-on-toolchain? dep0 "gcc-toolchain"))
+ (string=? (package-full-name dep0)
+ (package-full-name grep))
+ (match (bag-build-inputs (package->bag dep1))
+ ((("x" dep) _ ...)
+ (and (depends-on-toolchain? dep "gcc-toolchain")
+ (match (bag-build-inputs (package->bag dep))
+ ((("y" dep) _ ...) ;this one is unchanged
+ (eq? dep grep))))))))))))))
+
+(test-equal "options->transformation, with-c-toolchain twice"
+ (package-full-name grep)
+ (let* ((dep0 (dummy-package "chbouib"))
+ (dep1 (dummy-package "stuff"))
+ (p (dummy-package "thingie"
+ (build-system gnu-build-system)
+ (inputs `(("foo" ,dep0)
+ ("bar" ,dep1)
+ ("baz" ,grep)))))
+ (t (options->transformation
+ '((with-c-toolchain . "chbouib=clang-toolchain")
+ (with-c-toolchain . "stuff=clang-toolchain")))))
+ (with-store store
+ (let ((new (t store p)))
+ (and (depends-on-toolchain? new "clang-toolchain")
+ (match (bag-build-inputs (package->bag new))
+ ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...)
+ (and (depends-on-toolchain? dep0 "clang-toolchain")
+ (depends-on-toolchain? dep1 "clang-toolchain")
+ (not (depends-on-toolchain? dep2 "clang-toolchain"))
+ (package-full-name dep2)))))))))
+
+(test-assert "options->transformation, with-c-toolchain, no effect"
+ (let ((p (dummy-package "thingie"))
+ (t (options->transformation
+ '((with-c-toolchain . "does-not-exist=gcc-toolchain")))))
+ ;; When it has no effect, '--with-c-toolchain' returns P.
+ (with-store store
+ (eq? (t store p) p))))
+
(test-assert "options->transformation, without-tests"
(let* ((dep (dummy-package "dep"))
(p (dummy-package "foo"
@@ -286,3 +364,7 @@
'(#:tests? #f))))))))
(test-end)
+
+;;; Local Variables:
+;;; eval: (put 'dummy-package 'scheme-indent-function 1)
+;;; End:
--
2.28.0
