git: 'update-cached-checkout' gracefully handles missing starting commit.

Fixes <https://bugs.gnu.org/41604>
Reported by John Soo <jsoo1@asu.edu> and zimoun <zimon.toutoune@gmail.com>.

* guix/git.scm (false-if-git-not-found): New macro.
(reference-available?): Use it.
(update-cached-checkout): Use it when looking up STARTING-COMMIT.
Set RELATION to 'unrelated when OLD is #false.
This commit is contained in:
Ludovic Courtès 2020-06-07 22:14:56 +02:00
parent 715f589ea3
commit 1fd7de45f2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -243,18 +243,23 @@ (define* (update-submodules repository
(G_ "Support for submodules is missing; \ (G_ "Support for submodules is missing; \
please upgrade Guile-Git.~%")))) please upgrade Guile-Git.~%"))))
(define-syntax-rule (false-if-git-not-found exp)
"Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
(catch 'git-error
(lambda ()
exp)
(lambda (key error . rest)
(if (= GIT_ENOTFOUND (git-error-code error))
#f
(apply throw key error rest)))))
(define (reference-available? repository ref) (define (reference-available? repository ref)
"Return true if REF, a reference such as '(commit . \"cabba9e\"), is "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
definitely available in REPOSITORY, false otherwise." definitely available in REPOSITORY, false otherwise."
(match ref (match ref
(('commit . commit) (('commit . commit)
(catch 'git-error (false-if-git-not-found
(lambda () (->bool (commit-lookup repository (string->oid commit)))))
(->bool (commit-lookup repository (string->oid commit))))
(lambda (key error . rest)
(if (= GIT_ENOTFOUND (git-error-code error))
#f
(apply throw key error rest)))))
(_ (_
#f))) #f)))
@ -311,10 +316,13 @@ (define canonical-ref
(new (and starting-commit (new (and starting-commit
(commit-lookup repository oid))) (commit-lookup repository oid)))
(old (and starting-commit (old (and starting-commit
(false-if-git-not-found
(commit-lookup repository (commit-lookup repository
(string->oid starting-commit)))) (string->oid starting-commit)))))
(relation (and starting-commit (relation (and starting-commit
(commit-relation old new)))) (if old
(commit-relation old new)
'unrelated))))
;; Reclaim file descriptors and memory mappings associated with ;; Reclaim file descriptors and memory mappings associated with
;; REPOSITORY as soon as possible. ;; REPOSITORY as soon as possible.