From ae11fcb84ac478dfa56d322ef08890645183a087 Mon Sep 17 00:00:00 2001 From: Sarthak Shah Date: Tue, 25 Apr 2023 17:52:10 +0530 Subject: [PATCH] transformations: Add '--with-configure-flag'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- 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 ;;; Copyright © 2021 Marius Bakke +;;; Copyright © 2023 Sarthak Shah ;;; ;;; 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"