From abd7a474615353149a44f4504f0b4b248dcc0716 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 28 Sep 2020 18:56:00 +0200 Subject: guix build: Add '--with-c-toolchain'. * guix/scripts/build.scm (package-dependents/spec) (package-toolchain-rewriting, transform-package-toolchain): New procedures. (%transformations): Add it. (%transformation-options, show-transformation-options-help): Add '--with-c-toolchain'. * tests/scripts-build.scm (depends-on-toolchain?): New procedure. ("options->transformation, with-c-toolchain") ("options->transformation, with-c-toolchain twice") New test. ("options->transformation, with-c-toolchain, no effect"): New tests. * doc/guix.texi (Package Transformation Options): Document it. --- doc/guix.texi | 38 ++++++++++++++++++++++ guix/scripts/build.scm | 84 +++++++++++++++++++++++++++++++++++++++++++++++++ tests/scripts-build.scm | 82 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 204 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index e084144a82..7150adeaa8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9364,6 +9364,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: -- cgit 1.4.1