git: 'update-cached-checkout' supports a 'tag-or-commit' type of ref.

* guix/git.scm (switch-to-ref)[obj]: Wrap in 'resolve' lambda.  Add
'tag-or-commit' case.
(update-cached-checkout): Document it.
This commit is contained in:
Ludovic Courtès 2019-07-26 10:59:24 +02:00
parent 422e187fb4
commit c4c2449fea
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -139,29 +139,40 @@ (define (switch-to-ref repository ref)
"Switch to REPOSITORY's branch, commit or tag specified by REF. Return the
OID (roughly the commit hash) corresponding to REF."
(define obj
(match ref
(('branch . branch)
(let ((oid (reference-target
(branch-lookup repository branch BRANCH-REMOTE))))
(object-lookup repository oid)))
(('commit . commit)
(let ((len (string-length commit)))
;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
;; can't be sure it's available. Furthermore, 'string->oid' used to
;; read out-of-bounds when passed a string shorter than 40 chars,
;; which is why we delay calls to it below.
(if (< len 40)
(if (module-defined? (resolve-interface '(git object))
'object-lookup-prefix)
(object-lookup-prefix repository (string->oid commit) len)
(raise (condition
(&message
(message "long Git object ID is required")))))
(object-lookup repository (string->oid commit)))))
(('tag . tag)
(let ((oid (reference-name->oid repository
(string-append "refs/tags/" tag))))
(object-lookup repository oid)))))
(let resolve ((ref ref))
(match ref
(('branch . branch)
(let ((oid (reference-target
(branch-lookup repository branch BRANCH-REMOTE))))
(object-lookup repository oid)))
(('commit . commit)
(let ((len (string-length commit)))
;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
;; can't be sure it's available. Furthermore, 'string->oid' used to
;; read out-of-bounds when passed a string shorter than 40 chars,
;; which is why we delay calls to it below.
(if (< len 40)
(if (module-defined? (resolve-interface '(git object))
'object-lookup-prefix)
(object-lookup-prefix repository (string->oid commit) len)
(raise (condition
(&message
(message "long Git object ID is required")))))
(object-lookup repository (string->oid commit)))))
(('tag-or-commit . str)
(if (or (> (string-length str) 40)
(not (string-every char-set:hex-digit str)))
(resolve `(tag . ,str)) ;definitely a tag
(catch 'git-error
(lambda ()
(resolve `(tag . ,str)))
(lambda _
;; There's no such tag, so it must be a commit ID.
(resolve `(commit . ,str))))))
(('tag . tag)
(let ((oid (reference-name->oid repository
(string-append "refs/tags/" tag))))
(object-lookup repository oid))))))
(reset repository obj RESET_HARD)
(object-id obj))
@ -218,8 +229,8 @@ (define* (update-cached-checkout url
values: the cache directory name, and the SHA1 commit (a string) corresponding
to REF.
REF is pair whose key is [branch | commit | tag] and value the associated
data, respectively [<branch name> | <sha1> | <tag name>].
REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
the associated data: [<branch name> | <sha1> | <tag name> | <string>].
When RECURSIVE? is true, check out submodules as well, if any."
(define canonical-ref