07/08: transformations: Add '--with-configure-flag'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit ae11fcb84ac478dfa56d322ef08890645183a087
Author: Sarthak Shah <shahsarthakw@gmail.com>
AuthorDate: Tue Apr 25 17:52:10 2023 +0530

    transformations: Add '--with-configure-flag'.
    
    * guix/transformations.scm (transform-package-configure-flag): New
    procedure.
    (%transformation-options, %transformation-options)
    (show-transformation-options-help/detailed): Add it.
    * tests/transformations.scm ("options->transformation,
    with-configure-flag"): New test.
    * doc/guix.texi (Package Transformation Options): Document it.
    
    Co-authored-by: Ludovic Courtès <ludo@gnu.org>
---
 doc/guix.texi             | 29 +++++++++++++++++++++++++++++
 guix/transformations.scm  | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 tests/transformations.scm | 13 ++++++++++++-
 3 files changed, 88 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 7af2a85499..55221a10c3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12919,6 +12919,35 @@ guix build coreutils 
--with-patch=glibc=./glibc-frob.patch
 In this example, glibc itself as well as everything that leads to
 Coreutils in the dependency graph is rebuilt.
 
+@cindex configure flags, changing them
+@item --with-configure-flag=@var{package}=@var{flag}
+Append @var{flag} to the configure flags of @var{package}, where
+@var{package} is a spec such as @code{guile@@3.0} or @code{glibc}.  The
+build system of @var{package} must support the @code{#:configure-flags}
+argument.
+
+For example, the command below builds GNU@tie{}Hello with the
+configure flag @code{--disable-nls}:
+
+@example
+guix build hello --with-configure-flag=hello=--disable-nls
+@end example
+
+The following command passes an extra flag to @command{cmake} as it
+builds @code{lapack}:
+
+@example
+guix build lapack \
+  --with-configure-flag=lapack=-DBUILD_COMPLEX=OFF
+@end example
+
+@quotation Note
+Under the hood, this option works by passing the
+@samp{#:configure-flags} argument to the build system of the package of
+interest (@pxref{Build Systems}).  Most build systems support that
+option but some do not.  In that case, an error is raised.
+@end quotation
+
 @cindex upstream, latest version
 @item --with-latest=@var{package}
 @itemx --with-version=@var{package}=@var{version}
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 8ff472ad21..c050af2de8 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2023 Sarthak Shah <shahsarthakw@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -676,6 +677,46 @@ to the same package but with #:strip-binaries? #f in its 
'arguments' field."
         (rewrite obj)
         obj)))
 
+(define (transform-package-configure-flag specs)
+  "Return a procedure that, when passed a package and a flag, adds the flag to
+#:configure-flags in the package's 'arguments' field."
+  (define (package-with-configure-flag p extra-flag)
+    (package/inherit p
+      (arguments
+       (substitute-keyword-arguments (package-arguments p)
+         ((#:configure-flags flags #~'())
+          ;; Add EXTRA-FLAG to the end so it can potentially override FLAGS.
+          #~(append #$flags '(#$extra-flag)))))))
+
+  (define configure-flags
+    ;; Spec/flag alist.
+    (map (lambda (spec)
+           ;; Split SPEC on the first equal sign (the configure flag might
+           ;; contain equal signs, as in '-DINTSIZE=32').
+           (let ((equal (string-index spec #\=)))
+             (match (and equal
+                         (list (string-take spec equal)
+                               (string-drop spec (+ 1 equal))))
+               ((spec flag)
+                (cons spec flag))
+               (_
+                (raise (formatted-message
+                        (G_ "~a: invalid package configure flag specification")
+                        spec))))))
+         specs))
+
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (match-lambda
+            ((spec . flags)
+             (cons spec (cut package-with-configure-flag <> flags))))
+          configure-flags)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define (patched-source name source patches)
   "Return a file-like object with the given NAME that applies PATCHES to
 SOURCE.  SOURCE must itself be a file-like object of any type, including
@@ -845,6 +886,7 @@ are replaced by the specified upstream version."
     (tune . ,transform-package-tuning)
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
+    (with-configure-flag . ,transform-package-configure-flag)
     (with-patch  . ,transform-package-patches)
     (with-latest . ,transform-package-latest)
     (with-version . ,transform-package-version)))
@@ -915,6 +957,8 @@ building for ~a instead of ~a, so tuning cannot be 
guessed~%")
                   (parser 'with-debug-info))
           (option '("without-tests") #t #f
                   (parser 'without-tests))
+          (option '("with-configure-flag") #t #f
+                  (parser 'with-configure-flag))
           (option '("with-patch") #t #f
                   (parser 'with-patch))
           (option '("with-latest") #t #f
@@ -952,6 +996,9 @@ building for ~a instead of ~a, so tuning cannot be 
guessed~%")
   (display (G_ "
       --with-patch=PACKAGE=FILE
                          add FILE to the list of patches of PACKAGE"))
+  (display (G_ "
+      --with-configure-flag=PACKAGE=FLAG
+                         append FLAG to the configure flags of PACKAGE"))
   (display (G_ "
       --with-latest=PACKAGE
                          use the latest upstream release of PACKAGE"))
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 1fa2c0bba8..704818b9ed 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -33,7 +33,7 @@
   #:use-module ((guix gexp)
                 #:select (local-file? local-file-file
                           computed-file? computed-file-gexp
-                          gexp-input-thing))
+                          gexp-input-thing gexp->approximate-sexp))
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
@@ -408,6 +408,17 @@
                         (package-full-name grep))
               (package-arguments (package-replacement dep0))))))))
 
+(test-equal "options->transformation, with-configure-flag"
+  '(append '() '("--flag=42"))
+  (let* ((p   (dummy-package "foo"
+                (build-system gnu-build-system)))
+         (t   (options->transformation
+               '((with-configure-flag . "foo=--flag=42")))))
+    (let ((new (t p)))
+      (match (package-arguments new)
+        ((#:configure-flags flags)
+         (gexp->approximate-sexp flags))))))
+
 (test-assert "options->transformation, without-tests"
   (let* ((dep (dummy-package "dep"))
          (p   (dummy-package "foo"