[bug#43679] [PATCH 5/5] guix build: Add '--with-toolchain'.

[Ludovic Courtès]

From: Ludovic Courtès <ludovic.courtes@inria.fr>

* guix/scripts/build.scm (transform-package-toolchain): New procedure.
(%transformations): Add it.
(%transformation-options, show-transformation-options-help): Add
'--with-toolchain'.
* tests/scripts-build.scm ("options->transformation, with-toolchain"):
New test.
* doc/guix.texi (Package Transformation Options): Document it.
---
 doc/guix.texi           | 29 +++++++++++++++++++++++++++++
 guix/scripts/build.scm  | 40 ++++++++++++++++++++++++++++++++++++++++
 tests/scripts-build.scm | 30 ++++++++++++++++++++++++++++++
 3 files changed, 99 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 03836bbf7b..049958b55f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9310,6 +9310,35 @@ 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-toolchain=@var{package}=@var{toolchain}
+This option changes @var{package} so that it gets built with
+@var{toolchain} instead of the default GNU tool chain for C/C++.
+
+Consider this example:
+
+@example
+guix build octave-cli \
+  --with-toolchain=fftw=gcc-toolchain@@10 \
+  --with-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 built
+using the default tool chain.
+
+This other example builds the Hardware Locality (@code{hwloc}) library
+with the Clang C compiler, and then builds its dependents up to
+@code{intel-mpi-benchmarks} using the default tool chain, but linking
+them against the Clang-built @code{hwloc}:
+
+@example
+guix build --with-toolchain=hwloc=clang-toolchain \
+           intel-mpi-benchmarks
+@end example
+
 @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 f238e9b876..290046a808 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -393,6 +393,40 @@ a checkout of the Git repository at the given URL."
         (rewrite obj)
         obj)))
 
+(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
+                    (lambda (old)
+                      (let ((toolchain (map specification->input toolchain)))
+                        (package-with-toolchain old toolchain)))))
+             (_
+              (leave (G_ "~a: invalid toolchain replacement specification~%")
+                     spec))))
+         replacement-specs))
+
+  (define rewrite
+    (package-input-rewriting/spec replacements))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define (transform-package-tests specs)
   "Return a procedure that, when passed a package, sets #:tests? #f in its
 'arguments' field."
@@ -423,6 +457,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-toolchain . ,transform-package-toolchain)
     (without-tests . ,transform-package-tests)))
 
 (define %transformation-options
@@ -444,6 +479,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-toolchain") #t #f
+                  (parser 'with-toolchain))
           (option '("without-tests") #t #f
                   (parser 'without-tests)))))
 
@@ -466,6 +503,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-toolchain=PACKAGE=TOOLCHAIN
+                         build package 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..2dd1315722 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,32 @@
                        ((("x" dep3))
                         (map package-source (list dep1 dep3))))))))))))
 
+(test-equal "options->transformation, with-toolchain"
+  '("gcc-toolchain")
+  (let* ((p (dummy-package "thingie"
+              (build-system gnu-build-system)
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (build-system gnu-build-system)
+                                  (native-inputs `(("x" ,grep)))))))))
+         (t (options->transformation '((with-toolchain
+                                        . "chbouib=gcc-toolchain")))))
+    (define toolchain-packages
+      '("gcc" "binutils" "glibc" "ld-wrapper"))
+
+    (with-store store
+      (let ((new (t store p)))
+        (match (bag-build-inputs (package->bag new))
+          ((("foo" _) ("bar" dep) (_ (= package-name packages) . _) ...)
+           (and (every (cut member <> packages)
+                       toolchain-packages)
+                (match (bag-build-inputs (package->bag dep))
+                  ((("x" dep0) (_ (= package-name packages) . _) ...)
+                   (and (eq? dep0 grep)           ;this one is unchanged
+                        (not (any (cut member <> packages)
+                                  toolchain-packages))
+                        (member "gcc-toolchain" packages)))))))))))
+
 (test-assert "options->transformation, without-tests"
   (let* ((dep (dummy-package "dep"))
          (p   (dummy-package "foo"
-- 
2.28.0