diff mbox series

[bug#50377,1/2] git: 'resolve-reference' handles 'git describe'-style commit IDs.

Message ID 20210904181035.24161-1-marius@gnu.org
State Accepted
Headers show
Series Support 'git describe' style commit IDs in transformations | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Marius Bakke Sept. 4, 2021, 6:10 p.m. UTC 
* guix/git.scm (resolve-reference): Use REVPARSE-SINGLE for looking up
commits.  Rewrite tag-or-commit case to recognize 'git describe' style
identifiers and resolve them as commits.
---
 guix/git.scm | 37 ++++++++++++++++++++-----------------
 1 file changed, 20 insertions(+), 17 deletions(-)
diff mbox series

Patch

diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..5e52630f5a 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -2,6 +2,7 @@ 
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -214,24 +215,26 @@  corresponding Git object."
        (let ((oid (reference-name->oid repository symref)))
          (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)
-             (object-lookup-prefix repository (string->oid commit) len)
-             (object-lookup repository (string->oid commit)))))
+       (revparse-single repository 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))))))
+       (cond ((and (> (string-length str) 8)
+                   (string-contains str "-g")
+                   (match (string-split str #\-)
+                     ((components ... g+id)
+                      (string-every char-set:hex-digit
+                                    (string-drop g+id 1)))
+                     (_ #f)))
+              (resolve `(commit . ,str)))   ;looks like a 'git describe' style ID
+             ((or (> (string-length str) 40)
+                  (not (string-every char-set:hex-digit str)))
+              (resolve `(tag . ,str)))           ;definitely a tag
+             (else
+              (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))))