transformations: Git tags and 'git describe' style IDs are used as version.

* guix/transformations.scm (commit->version-string): New procedure.  Use git
tags and 'git describe' style identifiers directly.
(transform-package-source-commit): Adjust accordingly.
* tests/transformations.scm
("options->transformation, with-commit, version transformation"): New test.
* doc/guix.texi (Package Transformation Options): Mention the 'git describe'
style.

4 files changed, 46 insertions, 12 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index f88967b593..220499503d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10652,7 +10652,8 @@ guix build --with-branch=guile-sqlite3=master cuirass
 @item --with-commit=@var{package}=@var{commit}
 This is similar to @option{--with-branch}, except that it builds from
 @var{commit} rather than the tip of a branch.  @var{commit} must be a valid
-Git commit SHA1 identifier or a tag.
+Git commit SHA1 identifier, a tag, or a @command{git describe} style
+identifier such as @code{1.0-3-gabc123}.
 
 @item --with-patch=@var{package}=@var{file}
 Add @var{file} to the list of patches applied to @var{package}, where
diff --git a/guix/git.scm b/guix/git.scm
index 621de0e925..acc48fd12f 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -231,11 +231,11 @@ corresponding Git object."
                                (string-every char-set:digit revision)
                                (string-every char-set:hex-digit
                                              (string-drop g+commit 1)))
+                          ;; Looks like a 'git describe' style ID, like
+                          ;; v1.3.0-7-gaa34d4d28d.
                           (string-drop g+commit 1)
                           #f))
                      (_ #f)))
-              ;; Looks like a 'git describe' style ID, like
-              ;; v1.3.0-7-gaa34d4d28d.
               => (lambda (commit) (resolve `(commit . ,commit))))
              ((or (> (string-length str) 40)
                   (not (string-every char-set:hex-digit str)))
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 5122baa403..5ae1977cb2 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.
 ;;;
@@ -270,6 +271,25 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
           (rewrite obj)
           obj))))
 
+(define (commit->version-string commit)
+  "Return a string suitable for use in the 'version' field of a package based
+on the given COMMIT."
+  (cond ((and (> (string-length commit) 1)
+              (string-prefix? "v" commit)
+              (char-set-contains? char-set:digit
+                                  (string-ref commit 1)))
+         ;; Probably a tag like "v1.0" or a 'git describe' identifier.
+         (string-drop commit 1))
+        ((not (string-every char-set:hex-digit commit))
+         ;; Pass through tags and 'git describe' style IDs directly.
+         commit)
+        (else
+         (string-append "git."
+                        (if (< (string-length commit) 7)
+                            commit
+                            (string-take commit 7))))))
+
+
 (define (transform-package-source-commit replacement-specs)
   "Return a procedure that, when passed a package, replaces its direct
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
@@ -278,15 +298,7 @@ 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 (commit->version-string commit))
       (source (git-checkout (url url) (commit commit)
                             (recursive? #t)))))
 
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 3417c994ec..09839dc1c5 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,26 @@
                    (string=? (package-name dep2) "chbouib")
                    (package-source dep2))))))))
 
+(test-equal "options->transformation, with-commit, version transformation"
+  '("1.0" "1.0-rc1-2-gabc123" "git.abc123")
+  (map (lambda (commit)
+         (let* ((p (dummy-package "guix.scm"
+                     (inputs `(("foo" ,(dummy-package "chbouib"
+                                         (source (origin
+                                                   (method git-fetch)
+                                                   (uri (git-reference
+                                                         (url "https://example.org")
+                                                         (commit "cabba9e")))
+                                                   (sha256 #f)))))))))
+                (t (options->transformation
+                    `((with-commit . ,(string-append "chbouib=" commit))))))
+           (let ((new (t p)))
+             (and (not (eq? new p))
+                  (match (package-inputs new)
+                    ((("foo" dep1))
+                     (package-version dep1)))))))
+       '("v1.0" "1.0-rc1-2-gabc123" "abc123")))
+
 (test-equal "options->transformation, with-git-url"
   (let ((source (git-checkout (url "https://example.org")
                               (recursive? #t))))