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.master
parent
422e187fb4
commit
c4c2449fea
61
guix/git.scm
61
guix/git.scm
|
@ -139,29 +139,40 @@ of SHA1 string."
|
|||
"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 @@ please upgrade Guile-Git.~%"))))
|
|||
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
|
||||
|
|
Reference in New Issue