[bug#78034] guix: transformations: git source transformations honour RECURSIVE?.
Commit Message
* guix/transformations.scm (package-git-url+recursive?): New variable.
(package-git-url): Remove variable.
(evaluate-git-replacement-specs): Use package-git-url+recursive?.
(transform-package-source-branch, transform-package-source-commit, transform-package-source-git-url): Update
according to changes above.
* doc/guix.texi (Package Transformation Options): Update documentation.
* tests/transformations.scm: Update tests.
Change-Id: Id6a5e6957a9955c8173b06b3e14f2986c6dfc4bc
---
doc/guix.texi | 8 ++++---
guix/transformations.scm | 50 +++++++++++++++++++++++++--------------
tests/transformations.scm | 6 ++---
3 files changed, 39 insertions(+), 25 deletions(-)
base-commit: b12d44dd5e35ac236bf3fbb5619b9c8c2f42c902
Comments
Hello!
Overall LGTM! Minor suggestions:
Romain GARBAGE <romain.garbage@inria.fr> writes:
> + ;; Try to propagate RECURSIVE? from the package source when it
> + ;; is a git-checkout or a git-reference, keeping TRUE as
> + ;; default in other cases.
> + (let ((url recursive? (guard (c ((formatted-message? c )
> + (values url #t)))
> + (package-git-url+recursive? old))))
Instead of catching ‘formatted-message?’, I would rather add an ‘if’ for
origin + git-reference or git-checkout.
> --- a/tests/transformations.scm
> +++ b/tests/transformations.scm
> @@ -217,8 +217,7 @@ (define-module (test-transformations)
>
> (test-equal "options->transformation, with-branch"
> (git-checkout (url "https://example.org")
> - (branch "devel")
> - (recursive? #t))
> + (branch "devel"))
IWBN to add a test where (recursive? #t) is inherited.
Thanks,
Ludo’.
@@ -13584,9 +13584,11 @@ Package Transformation Options
@item --with-git-url=@var{package}=@var{url}
@cindex Git, using the latest commit
@cindex latest commit, building
-Build @var{package} from the latest commit of the @code{master} branch of the
-Git repository at @var{url}. Git sub-modules of the repository are fetched,
-recursively.
+Build @var{package} from the latest commit of the @code{master} branch
+of the Git repository at @var{url}. Git sub-modules of the repository
+are fetched, recursively, if @var{package} @code{source} is not a Git
+repository, otherwise it depends on the inherited value of
+@code{recursive?}.
For example, the following command builds the NumPy Python library against the
latest commit of the master branch of Python itself:
@@ -29,8 +29,13 @@ (define-module (guix transformations)
#:use-module (guix profiles)
#:use-module (guix diagnostics)
#:autoload (guix download) (download-to-store)
- #:autoload (guix git-download) (git-reference? git-reference-url)
- #:autoload (guix git) (git-checkout git-checkout? git-checkout-url)
+ #:autoload (guix git-download) (git-reference?
+ git-reference-url
+ git-reference-recursive?)
+ #:autoload (guix git) (git-checkout
+ git-checkout?
+ git-checkout-url
+ git-checkout-recursive?)
#:autoload (guix upstream) (upstream-source
package-latest-release
preferred-upstream-source
@@ -234,15 +239,18 @@ (define (transform-package-inputs/graft replacement-specs)
(define %not-equal
(char-set-complement (char-set #\=)))
-(define (package-git-url package)
- "Return the URL of the Git repository for package, or raise an error if
-the source of PACKAGE is not fetched from a Git repository."
+(define (package-git-url+recursive? package)
+ "Return two values: the URL of the Git repository for package and a boolean
+indicating if the repository has to be recursively cloned, or raise an error if the
+source of PACKAGE is not fetched from a Git repository."
(let ((source (package-source package)))
(cond ((and (origin? source)
(git-reference? (origin-uri source)))
- (git-reference-url (origin-uri source)))
+ (values (git-reference-url (origin-uri source))
+ (git-reference-recursive? (origin-uri source))))
((git-checkout? source)
- (git-checkout-url source))
+ (values (git-checkout-url source)
+ (git-checkout-recursive? source)))
(else
(raise
(formatted-message (G_ "the source of ~a is not a Git reference")
@@ -257,9 +265,9 @@ (define (evaluate-git-replacement-specs specs proc)
(match (string-tokenize spec %not-equal)
((spec branch-or-commit)
(define (replace old)
- (let* ((source (package-source old))
- (url (package-git-url old)))
- (proc old url branch-or-commit)))
+ (let* ((source (package-source old))
+ (url recursive? (package-git-url+recursive? old)))
+ (proc old url branch-or-commit recursive?)))
(cons spec replace))
(_
@@ -273,7 +281,7 @@ (define (transform-package-source-branch replacement-specs)
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile-next=stable-3.0\" meaning that packages are built using
'guile-next' from the latest commit on its 'stable-3.0' branch."
- (define (replace old url branch)
+ (define (replace old url branch recursive?)
(package
(inherit old)
(version (string-append "git." (string-map (match-lambda
@@ -281,7 +289,7 @@ (define (transform-package-source-branch replacement-specs)
(chr chr))
branch)))
(source (git-checkout (url url) (branch branch)
- (recursive? #t)))))
+ (recursive? recursive?)))))
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace))
@@ -315,12 +323,12 @@ (define (transform-package-source-commit replacement-specs)
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile-next=cabba9e\" meaning that packages are built using
'guile-next' from commit 'cabba9e'."
- (define (replace old url commit)
+ (define (replace old url commit recursive?)
(package
(inherit old)
(version (commit->version-string commit))
(source (git-checkout (url url) (commit commit)
- (recursive? #t)))))
+ (recursive? recursive?)))))
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace))
@@ -341,10 +349,16 @@ (define (transform-package-source-git-url replacement-specs)
((spec url)
(cons spec
(lambda (old)
- (package
- (inherit old)
- (source (git-checkout (url url)
- (recursive? #t)))))))
+ ;; Try to propagate RECURSIVE? from the package source when it
+ ;; is a git-checkout or a git-reference, keeping TRUE as
+ ;; default in other cases.
+ (let ((url recursive? (guard (c ((formatted-message? c )
+ (values url #t)))
+ (package-git-url+recursive? old))))
+ (package
+ (inherit old)
+ (source (git-checkout (url url)
+ (recursive? recursive?))))))))
(_
(raise
(formatted-message
@@ -217,8 +217,7 @@ (define-module (test-transformations)
(test-equal "options->transformation, with-branch"
(git-checkout (url "https://example.org")
- (branch "devel")
- (recursive? #t))
+ (branch "devel"))
(let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,grep)
("bar" ,(dummy-package "chbouib"
@@ -240,8 +239,7 @@ (define-module (test-transformations)
(test-equal "options->transformation, with-commit"
(git-checkout (url "https://example.org")
- (commit "abcdef")
- (recursive? #t))
+ (commit "abcdef"))
(let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,grep)
("bar" ,(dummy-package "chbouib"