guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 6aaed933bf63d6bc1f404124906cdd20ac67d3ba
Author: Nicolas Graves <[email protected]>
AuthorDate: Tue Sep 16 15:46:13 2025 +0200
import: utils: Add generate-git-source procedure.
This procedure tries to generate a <origin> sexp from a single url and
version.
* guix/import/utils.scm (generate-git-source): Add procedure.
* tests/import/utils.scm: Add tests for generate-git-source.
Signed-off-by: Ludovic Courtès <[email protected]>
---
guix/import/utils.scm | 19 +++++++++++++++++++
tests/import/utils.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
2 files changed, 61 insertions(+)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 77ea1ed1fa..0590ed1990 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -78,6 +78,7 @@
git-origin
git->origin
default-git-error
+ generate-git-source
package-names->package-inputs
maybe-inputs
@@ -238,6 +239,24 @@ LOCATION."
(_
#f)))
+(define (generate-git-source repository version error-procedure)
+ "Try to download a given VERSION from a REPOSITORY url twice. Call
+ERROR-PROCEDURE if both attempts fail."
+ (catch 'git-error
+ (lambda ()
+ (git->origin repository
+ (peekable-lambda (version)
+ (string-append "v" version))
+ version))
+ (lambda (key . args)
+ ;; If tag fails, try with plain version string.
+ (catch 'git-error
+ (lambda ()
+ (git->origin repository
+ (peekable-lambda (version) version)
+ version))
+ error-procedure))))
+
(define %spdx-license-identifiers
;; https://spdx.org/licenses/
;; The gfl1.0, nmap, repoze
diff --git a/tests/import/utils.scm b/tests/import/utils.scm
index 72f8e059a2..b631ba2326 100644
--- a/tests/import/utils.scm
+++ b/tests/import/utils.scm
@@ -26,8 +26,10 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix build-system)
+ #:use-module (guix tests git)
#:use-module (gnu packages)
#:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 match))
(test-begin "import-utils")
@@ -302,4 +304,44 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS."))
(let ((home-page "https://github.com/user/repo";))
((default-git-error home-page) '(some-other-error "message"))))
+;;;
+;;; generate-git-source
+;;;
+
+(define (test-generate-git-source git-version version)
+ "Helper to test generate-git-source. Creates a temporary git repository with
+GIT-VERSION tag, attempts to generate source for VERSION, and returns two
+values: the git-source commit S-expression, and a boolean indicating if the
+error procedure has been called."
+ (with-temporary-git-repository directory
+ `((add "README" "Initial commit")
+ (commit "First commit")
+ (tag ,git-version ,version))
+ (mock ((guix import utils) git-repository-url? (const #t))
+ (let* ((error-called? #f)
+ (error-proc (lambda args
+ (set! error-called? #t)
+ #f)))
+ (match (generate-git-source directory version error-proc)
+ (`(origin
+ (method git-fetch)
+ (uri (git-reference (url ,url)
+ (commit ,commit-sexp)))
+ . ,rest)
+ (values commit-sexp error-called?))
+ (_
+ (values #f error-called?)))))))
+
+(test-equal "generate-git-source: version with 'v' prefix tag"
+ '(string-append "v" version)
+ (test-generate-git-source "v1.0.0" "1.0.0"))
+
+(test-equal "generate-git-source: version without 'v' prefix tag"
+ 'version
+ (test-generate-git-source "1.0.0" "1.0.0"))
+
+(test-assert "generate-git-source: calls error-procedure when tag not found"
+ (let ((sexp error-called? (test-generate-git-source "1.0.0" "2.0.0")))
+ error-called?))
+
(test-end "import-utils")
