07/09: packages: Add 'package-with-c-toolchain'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 46135ce4cefab9e164d75697d7ea0c8359b842e4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Sep 28 17:36:42 2020 +0200

    packages: Add 'package-with-c-toolchain'.
    
    * guix/build-system.scm (build-system-with-c-toolchain): New procedure.
    * guix/packages.scm (package-with-c-toolchain): New procedure.
    * tests/packages.scm ("package-with-c-toolchain"): New test.
    * doc/guix.texi (package Reference): Document 'package-with-c-toolchain'.
    (Build Systems): Mention it.
---
 doc/guix.texi         | 32 ++++++++++++++++++++++++++++++++
 guix/build-system.scm | 35 +++++++++++++++++++++++++++++++++--
 guix/packages.scm     |  9 +++++++++
 tests/packages.scm    | 20 ++++++++++++++++++++
 4 files changed, 94 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8514dfe..e084144 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6558,6 +6558,35 @@ cross-compiling:
 It is an error to refer to @code{this-package} outside a package definition.
 @end deffn
 
+Because packages are regular Scheme objects that capture a complete
+dependency graph and associated build procedures, it is often useful to
+write procedures that take a package and return a modified version
+thereof according to some parameters.  Below are a few examples.
+
+@cindex tool chain, choosing a package's tool chain
+@deffn {Scheme Procedure} package-with-c-toolchain @var{package} 
@var{toolchain}
+Return a variant of @var{package} that uses @var{toolchain} instead of
+the default GNU C/C++ toolchain.  @var{toolchain} must be a list of
+inputs (label/package tuples) providing equivalent functionality, such
+as the @code{gcc-toolchain} package.
+
+The example below returns a variant of the @code{hello} package built
+with GCC@tie{}10.x and the rest of the GNU tool chain (Binutils and the
+GNU C Library) instead of the default tool chain:
+
+@lisp
+(let ((toolchain (specification->package "gcc-toolchain@@10")))
+  (package-with-c-toolchain hello `(("toolchain" ,toolchain))))
+@end lisp
+
+The build tool chain is part of the @dfn{implicit inputs} of
+packages---it's usually not listed as part of the various ``inputs''
+fields and is instead pulled in by the build system.  Consequently, this
+procedure works by changing the build system of @var{package} so that it
+pulls in @var{toolchain} instead of the defaults.  @ref{Build Systems},
+for more on build systems.
+@end deffn
+
 @node origin Reference
 @subsection @code{origin} Reference
 
@@ -6694,6 +6723,9 @@ ornamentation---in other words, a bag is a lower-level 
representation of
 a package, which includes all the inputs of that package, including some
 that were implicitly added by the build system.  This intermediate
 representation is then compiled to a derivation (@pxref{Derivations}).
+The @code{package-with-c-toolchain} is an example of a way to change the
+implicit inputs that a package's build system pulls in (@pxref{package
+Reference, @code{package-with-c-toolchain}}).
 
 Build systems accept an optional list of @dfn{arguments}.  In package
 definitions, these are passed @i{via} the @code{arguments} field
diff --git a/guix/build-system.scm b/guix/build-system.scm
index 4174972..76d6709 100644
--- a/guix/build-system.scm
+++ b/guix/build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,7 @@
 
 (define-module (guix build-system)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (build-system
             build-system?
@@ -37,7 +38,9 @@
             bag-arguments
             bag-build
 
-            make-bag))
+            make-bag
+
+            build-system-with-c-toolchain))
 
 (define-record-type* <build-system> build-system make-build-system
   build-system?
@@ -98,3 +101,31 @@ intermediate representation just above derivations."
             #:outputs outputs
             #:target target
             arguments))))
+
+(define (build-system-with-c-toolchain bs toolchain)
+  "Return a variant of BS, a build system, that uses TOOLCHAIN instead of the
+default GNU C/C++ toolchain.  TOOLCHAIN must be a list of
+inputs (label/package tuples) providing equivalent functionality, such as the
+'gcc-toolchain' package."
+  (define lower
+    (build-system-lower bs))
+
+  (define toolchain-packages
+    ;; These are the GNU toolchain packages pulled in by GNU-BUILD-SYSTEM and
+    ;; all the build systems that inherit from it.  Keep the list in sync with
+    ;; 'standard-packages' in (guix build-system gnu).
+    '("gcc" "binutils" "libc" "libc:static" "ld-wrapper"))
+
+  (define (lower* . args)
+    (let ((lowered (apply lower args)))
+      (bag
+        (inherit lowered)
+        (build-inputs
+         (append (fold alist-delete
+                       (bag-build-inputs lowered)
+                       toolchain-packages)
+                 toolchain)))))
+
+  (build-system
+    (inherit bs)
+    (lower lower*)))
diff --git a/guix/packages.scm b/guix/packages.scm
index 4f2bb432..24d6417 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -124,6 +124,7 @@
             package-patched-vulnerabilities
             package-with-patches
             package-with-extra-patches
+            package-with-c-toolchain
             package/inherit
 
             transitive-input-references
@@ -790,6 +791,14 @@ specifies modules in scope when evaluating SNIPPET."
                         (append (origin-patches (package-source original))
                                 patches)))
 
+(define (package-with-c-toolchain package toolchain)
+  "Return a variant of PACKAGE that uses TOOLCHAIN instead of the default GNU
+C/C++ toolchain.  TOOLCHAIN must be a list of inputs (label/package tuples)
+providing equivalent functionality, such as the 'gcc-toolchain' package."
+  (let ((bs (package-build-system package)))
+    (package/inherit package
+      (build-system (build-system-with-c-toolchain bs toolchain)))))
+
 (define (transitive-inputs inputs)
   "Return the closure of INPUTS when considering the 'propagated-inputs'
 edges.  Omit duplicate inputs, except for those already present in INPUTS
diff --git a/tests/packages.scm b/tests/packages.scm
index 5d5abcb..2d13d91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1430,6 +1430,26 @@
           (derivation-file-name
            (package-derivation %store coreutils))))))))
 
+(test-assert "package-with-c-toolchain"
+  (let* ((dep (dummy-package "chbouib"
+                (build-system gnu-build-system)
+                (native-inputs `(("x" ,grep)))))
+         (p0  (dummy-package "thingie"
+                (build-system gnu-build-system)
+                (inputs `(("foo" ,grep)
+                          ("bar" ,dep)))))
+         (tc  (dummy-package "my-toolchain"))
+         (p1  (package-with-c-toolchain p0 `(("toolchain" ,tc)))))
+    (define toolchain-packages
+      '("gcc" "binutils" "glibc" "ld-wrapper"))
+
+    (match (bag-build-inputs (package->bag p1))
+      ((("foo" foo) ("bar" bar) (_ (= package-name packages) . _) ...)
+       (and (not (any (cut member <> packages) toolchain-packages))
+            (member "my-toolchain" packages)
+            (eq? foo grep)
+            (eq? bar dep))))))
+
 (test-equal "package-patched-vulnerabilities"
   '(("CVE-2015-1234")
     ("CVE-2016-1234" "CVE-2018-4567")