git: Nicely report '--with-commit' errors.
* guix/git.scm (latest-repository-commit*): Rewrite to catch 'git-error'. * po/guix/POTFILES.in: Add guix/git.scm. * tests/guix-build-branch.sh: Test --with-commit errors.
This commit is contained in:
parent
b18f7234aa
commit
a3d77c51bc
28
guix/git.scm
28
guix/git.scm
|
@ -20,6 +20,7 @@
|
||||||
(define-module (guix git)
|
(define-module (guix git)
|
||||||
#:use-module (git)
|
#:use-module (git)
|
||||||
#:use-module (git object)
|
#:use-module (git object)
|
||||||
|
#:use-module (guix i18n)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (gcrypt hash)
|
#:use-module (gcrypt hash)
|
||||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||||
|
@ -206,8 +207,31 @@ Log progress and checkout info to LOG-PORT."
|
||||||
(branch git-checkout-branch (default "master"))
|
(branch git-checkout-branch (default "master"))
|
||||||
(commit git-checkout-commit (default #f)))
|
(commit git-checkout-commit (default #f)))
|
||||||
|
|
||||||
(define latest-repository-commit*
|
(define* (latest-repository-commit* url #:key ref log-port)
|
||||||
(store-lift latest-repository-commit))
|
;; Monadic variant of 'latest-repository-commit'.
|
||||||
|
(lambda (store)
|
||||||
|
;; The caller--e.g., (guix scripts build)--may not handle 'git-error' so
|
||||||
|
;; translate it into '&message' conditions that we know will be properly
|
||||||
|
;; handled.
|
||||||
|
(catch 'git-error
|
||||||
|
(lambda ()
|
||||||
|
(values (latest-repository-commit store url
|
||||||
|
#:ref ref #:log-port log-port)
|
||||||
|
store))
|
||||||
|
(lambda (key error . _)
|
||||||
|
(raise (condition
|
||||||
|
(&message
|
||||||
|
(message
|
||||||
|
(match ref
|
||||||
|
(('commit . commit)
|
||||||
|
(format #f (G_ "cannot fetch commit ~a from ~a: ~a")
|
||||||
|
commit url (git-error-message error)))
|
||||||
|
(('branch . branch)
|
||||||
|
(format #f (G_ "cannot fetch branch '~a' from ~a: ~a")
|
||||||
|
branch url (git-error-message error)))
|
||||||
|
(_
|
||||||
|
(format #f (G_ "Git failure while fetching ~a: ~a")
|
||||||
|
url (git-error-message error))))))))))))
|
||||||
|
|
||||||
(define-gexp-compiler (git-checkout-compiler (checkout <git-checkout>)
|
(define-gexp-compiler (git-checkout-compiler (checkout <git-checkout>)
|
||||||
system target)
|
system target)
|
||||||
|
|
|
@ -43,4 +43,5 @@ guix/http-client.scm
|
||||||
guix/nar.scm
|
guix/nar.scm
|
||||||
guix/channels.scm
|
guix/channels.scm
|
||||||
guix/profiles.scm
|
guix/profiles.scm
|
||||||
|
guix/git.scm
|
||||||
nix/nix-daemon/guix-daemon.cc
|
nix/nix-daemon/guix-daemon.cc
|
||||||
|
|
|
@ -51,3 +51,6 @@ v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=9e3eacdec1d -d`"
|
||||||
guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
|
guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
|
||||||
test "$v0_1_0_drv" != "$latest_drv"
|
test "$v0_1_0_drv" != "$latest_drv"
|
||||||
test "$v0_1_0_drv" != "$orig_drv"
|
test "$v0_1_0_drv" != "$orig_drv"
|
||||||
|
|
||||||
|
if guix build guix --with-commit=guile-gcrypt=000 -d
|
||||||
|
then false; else true; fi
|
||||||
|
|
Loading…
Reference in New Issue