From: "Ludovic Courtès" <ludo@gnu.org>
To: 42381@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#42381] [PATCH 1/3] git: Factorize 'resolve-reference'.
Date: Thu, 16 Jul 2020 01:18:56 +0200 [thread overview]
Message-ID: <20200715231858.10201-1-ludo@gnu.org> (raw)
In-Reply-To: <20200715221506.8468-1-ludo@gnu.org>
* guix/git.scm (resolve-reference): New procedure.
(switch-to-ref): Use it.
---
guix/git.scm | 79 ++++++++++++++++++++++++++++------------------------
1 file changed, 42 insertions(+), 37 deletions(-)
diff --git a/guix/git.scm b/guix/git.scm
index 19c1cb59d3..ca67b1d37c 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -150,47 +150,52 @@ of SHA1 string."
(last (string-split url #\/)) ".git" "")
"-" (string-take sha1 7)))
+(define (resolve-reference repository ref)
+ "Resolve the branch, commit or tag specified by REF, and return the
+corresponding Git object."
+ (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))))
+ ;; OID may point to a "tag" object, but it can also point directly
+ ;; to a "commit" object, as surprising as it may seem. Return that
+ ;; object, whatever that is.
+ (object-lookup repository oid))))))
+
(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
- (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))))
- ;; OID may point to a "tag" object, but it can also point directly
- ;; to a "commit" object, as surprising as it may seem. Return that
- ;; object, whatever that is.
- (object-lookup repository oid))))))
+ (resolve-reference repository ref))
(reset repository obj RESET_HARD)
(object-id obj))
--
2.27.0
next prev parent reply other threads:[~2020-07-15 23:20 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-07-15 22:15 [bug#42381] [PATCH 0/3] 'reconfigure' disallows downgrades by default Ludovic Courtès
2020-07-15 23:18 ` Ludovic Courtès [this message]
2020-07-15 23:18 ` [bug#42381] [PATCH 2/3] git: 'update-cached-checkout' has a new #:check-out? parameter Ludovic Courtès
2020-07-15 23:18 ` [bug#42381] [PATCH 3/3] guix system: 'reconfigure' disallows downgrades by default Ludovic Courtès
2020-07-22 22:34 ` bug#42381: [PATCH 0/3] " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200715231858.10201-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=42381@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).