From c4c2449fea9b7fd78f61ffb9bbe19ab2ef6c8b41 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 26 Jul 2019 10:59:24 +0200
Subject: 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.
---
 guix/git.scm | 61 +++++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 36 insertions(+), 25 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index 289537dedf..fb2df2de07 100644
--- a/guix/git.scm
+++ b/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
-- 
cgit v1.2.3