amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

transformations: Git source transformations honour RECURSIVE?.

Browse source 
* 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. Add tests for RECURSIVE?
inheritance with WITH-COMMIT and WITH-SOURCE.

Change-Id: Id6a5e6957a9955c8173b06b3e14f2986c6dfc4bc
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Romain GARBAGE 2025-04-25 10:32:20 +02:00 • committed by Ludovic Courtès
parent 63088c295d
commit 79bc4ebb33
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 89 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

8
doc/guix.texi
View file

@ -13586,9 +13586,11 @@ the risks of incompatibility but cannot entirely eliminate them. Choose
@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:

53
guix/transformations.scm
View file

@ -29,8 +29,13 @@
#: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 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
(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 @@ syntax, or if a package it refers to could not be found."
(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 @@ syntax, or if a package it refers to could not be found."
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 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
(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 @@ on the given COMMIT."
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,19 @@ a checkout of the Git repository at the given URL."
((spec url)
(cons spec
(lambda (old)
(package
(inherit old)
(source (git-checkout (url url)
(recursive? #t)))))))
;; Propagate RECURSIVE? from the package source when it is a
;; git-checkout or a git-reference, keeping TRUE as default in
;; other cases.
(let* ((uri (and (origin? (package-source old))
(origin-uri (package-source old))))
(recursive? (if (or (git-checkout? uri)
(git-reference? uri))
(package-git-url+recursive? old)
#t)))
(package
(inherit old)
(source (git-checkout (url url)
(recursive? recursive?))))))))
(_
(raise
(formatted-message

52
tests/transformations.scm
View file

@ -217,8 +217,7 @@
(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"
@ -238,7 +237,53 @@
(string=? (package-name dep2) "chbouib")
(package-source dep2))))))))
(test-equal "options->transformation, with-branch, recursive? inheritance"
(git-checkout (url "https://example.org")
(branch "devel")
(recursive? #t))
(let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,grep)
("bar" ,(dummy-package "chbouib"
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://example.org")
(commit "cabba9e")
(recursive? #t)))
(sha256 #f)))))))))
(t (options->transformation '((with-branch . "chbouib=devel")))))
(let ((new (t p)))
(and (not (eq? new p))
(match (package-inputs new)
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name grep))
(string=? (package-name dep2) "chbouib")
(package-source dep2))))))))
(test-equal "options->transformation, with-commit"
(git-checkout (url "https://example.org")
(commit "abcdef"))
(let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,grep)
("bar" ,(dummy-package "chbouib"
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://example.org")
(commit "cabba9e")))
(sha256 #f)))))))))
(t (options->transformation '((with-commit . "chbouib=abcdef")))))
(let ((new (t p)))
(and (not (eq? new p))
(match (package-inputs new)
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name grep))
(string=? (package-name dep2) "chbouib")
(package-source dep2))))))))
(test-equal "options->transformation, with-commit, recursive? inheritance"
(git-checkout (url "https://example.org")
(commit "abcdef")
(recursive? #t))
@ -249,7 +294,8 @@
(method git-fetch)
(uri (git-reference
(url "https://example.org")
(commit "cabba9e")))
(commit "cabba9e")
(recursive? #t)))
(sha256 #f)))))))))
(t (options->transformation '((with-commit . "chbouib=abcdef")))))
(let ((new (t p)))