guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 438a003051115b62f853e9db6c098be3d8c9c45e
Author: Nicolas Graves <[email protected]>
AuthorDate: Wed Sep 24 21:26:44 2025 +0200
import: utils: Fix default-git-error.
This function was missing one argument.
* guix/import/utils.scm (default-git-error): Add and document location
argument.
* tests/import/utils.scm: Add tests for default-git-error.
Signed-off-by: Ludovic Courtès <[email protected]>
---
guix/import/utils.scm | 5 +++--
tests/import/utils.scm | 24 ++++++++++++++++++++++++
2 files changed, 27 insertions(+), 2 deletions(-)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index c389b25dca..77ea1ed1fa 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -225,8 +225,9 @@ be a procedure with a 'body property, used to generate the
origin sexp."
(values #f #f #f))))
(values (git-origin url (peek-body proc) hash) directory)))
-(define (default-git-error home-page)
- "Return a procedure to be passed to a `git-error' `catch' for HOME-PAGE."
+(define* (default-git-error home-page #:optional location)
+ "Return a procedure to be passed to a `git-error' `catch' for HOME-PAGE at
+LOCATION."
(match-lambda*
(('git-error error)
(warning location
diff --git a/tests/import/utils.scm b/tests/import/utils.scm
index 273f18254e..72f8e059a2 100644
--- a/tests/import/utils.scm
+++ b/tests/import/utils.scm
@@ -21,6 +21,7 @@
(define-module (test-import-utils)
#:use-module (guix tests)
+ #:use-module ((guix diagnostics) #:select (location))
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
@@ -278,4 +279,27 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS."))
(map spdx-string->license
'("GPL-3.0-oR-LaTeR" "AGPL-3.0" "GPL-2.0+")))
+;;;
+;;; default-git-error
+;;;
+
+(test-assert "default-git-error: returns a procedure without location argument"
+ (procedure?
+ (default-git-error "https://github.com/user/repo";)))
+
+(test-assert "default-git-error: returns a procedure with location argument"
+ (procedure?
+ (default-git-error "https://github.com/user/repo";
+ (location "none.scm" 42 0))))
+
+(test-equal "default-git-error: procedure handles git-error"
+ #f
+ (let ((home-page "https://github.com/user/repo";))
+ ((default-git-error home-page) '(git-error "some error message"))))
+
+(test-equal "default-git-error: returns #f for non-git-error"
+ #f
+ (let ((home-page "https://github.com/user/repo";))
+ ((default-git-error home-page) '(some-other-error "message"))))
+
(test-end "import-utils")
