diff mbox series

[bug#50377,2/2] transformations: 'git describe' style commit IDs are used as version.

Message ID 20210904181035.24161-2-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/transformations.scm (transform-package-source-commit): Look for
'git describe' style IDs and use it as the version if applicable.
* tests/transformations.scm
("options->transformation, with-commit, 'git describe' style version"): New
test.
---
 guix/transformations.scm  | 34 +++++++++++++++++++++++++---------
 tests/transformations.scm | 19 +++++++++++++++++++
 2 files changed, 44 insertions(+), 9 deletions(-)
diff mbox series

Patch

diff --git a/guix/transformations.scm b/guix/transformations.scm
index 5122baa403..e91bce3808 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,6 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -278,15 +279,30 @@  strings like \"guile-next=cabba9e\" meaning that packages are built using
   (define (replace old url commit)
     (package
       (inherit old)
-      (version (if (and (> (string-length commit) 1)
-                        (string-prefix? "v" commit)
-                        (char-set-contains? char-set:digit
-                                            (string-ref commit 1)))
-                   (string-drop commit 1)        ;looks like a tag like "v1.0"
-                   (string-append "git."
-                                  (if (< (string-length commit) 7)
-                                      commit
-                                      (string-take commit 7)))))
+      (version (cond ((and (> (string-length commit) 8)
+                           (string-contains commit "-g")
+                           (match (string-split commit #\-)
+                             ((components ... g+id)
+                              (char-set-every (cut char-set-contains?
+                                                   char-set:hex-digit <>)
+                                              (string->char-set
+                                               (string-drop g+id 1))))
+                             (_ #f)))
+                      ;; This looks like a 'git describe' style ID.  Drop
+                      ;; the 'v' prefix if applicable.
+                      (if (string-prefix? "v" commit)
+                          (string-drop commit 1)
+                          commit))
+                     ((and (> (string-length commit) 1)
+                           (string-prefix? "v" commit)
+                           (char-set-contains? char-set:digit
+                                               (string-ref commit 1)))
+                      (string-drop commit 1))       ;looks like a tag like "v1.0"
+                     (else
+                      (string-append "git."
+                                     (if (< (string-length commit) 7)
+                                         commit
+                                         (string-take commit 7))))))
       (source (git-checkout (url url) (commit commit)
                             (recursive? #t)))))
 
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 3417c994ec..44fccffcce 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,6 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -235,6 +236,24 @@ 
                    (string=? (package-name dep2) "chbouib")
                    (package-source dep2))))))))
 
+(test-equal "options->transformation, with-commit, 'git describe' style version"
+  "1.0-gcabba9e2"
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (source (origin
+                                            (method git-fetch)
+                                            (uri (git-reference
+                                                  (url "https://example.org")
+                                                  (commit "cabba9e")))
+                                            (sha256 #f)))))))))
+         (t (options->transformation '((with-commit . "chbouib=v1.0-gcabba9e2")))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (package-version dep2)))))))
+
 (test-equal "options->transformation, with-git-url"
   (let ((source (git-checkout (url "https://example.org")
                               (recursive? #t))))