unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Xinglu Chen <public@yoctocell.xyz>
To: 50359@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>, "Sarah Morgensen" <iskarian@mgsn.dev>
Subject: [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater.
Date: Fri, 17 Sep 2021 10:04:49 +0200	[thread overview]
Message-ID: <78cfc99b42371c9c21189f805030f11ca7e78861.1631865317.git.public@yoctocell.xyz> (raw)
In-Reply-To: <cover.1631865317.git.public@yoctocell.xyz>

* guix/git.scm (ls-remote-refs): New procedure.
* tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* tests/import-git.scm: New test file.
* Makefile.am (MODULES, SCM_TESTS): Register the new files.

Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
---
 Makefile.am          |   2 +
 doc/guix.texi        |  34 ++++++
 guix/git.scm         |  41 ++++++++
 guix/import/git.scm  | 225 +++++++++++++++++++++++++++++++++++++++
 tests/git.scm        |  28 +++++
 tests/import-git.scm | 245 +++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 575 insertions(+)
 create mode 100644 guix/import/git.scm
 create mode 100644 tests/import-git.scm

diff --git a/Makefile.am b/Makefile.am
index 299bc0f7fb..f3bdc7448e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
@@ -473,6 +474,7 @@ SCM_TESTS =					\
   tests/graph.scm				\
   tests/gremlin.scm				\
   tests/hackage.scm				\
+  tests/import-git.scm				\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 2fc9687910..6436e83a7c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11928,6 +11928,40 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{release-tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{release-tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{release-tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+
+@item @code{accept-pre-releases}: by default, the updater will ignore
+pre-releases; to make it also look for pre-releases, set the this
+property to @code{#t}.
+
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((release-tag-prefix . "^release0-")
+      (release-tag-suffix . "[a-z]?$")
+      (release-tag-version-delimiter . ":"))))
+@end lisp
+
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..bbff4fc890 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -57,6 +57,8 @@
             commit-difference
             commit-relation
 
+            remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -571,6 +573,45 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (define (remote-head->ref remote)
+    (let ((name (remote-head-name remote)))
+      (and (include? name)
+           name)))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+
+        (let* ((remote-heads (remote-ls remote))
+               (refs (filter-map remote-head->ref remote-heads)))
+          ;; Wait until we're finished with the repository before closing it.
+          (remote-disconnect remote)
+          (repository-close! repository)
+          refs))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..1eb219f3fe
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,225 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater
+
+            ;; For tests.
+            latest-git-tag-version))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `release-tag-prefix',
+;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
+;;; package to make the updater parse the Git tag name correctly.
+;;;
+;;; Possible improvements:
+;;;
+;;; * More robust method for trying to guess the delimiter.  Maybe look at the
+;;;   previous version/tag combo to determine the delimiter.
+;;;
+;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g.,
+;;;   2021.12.31.  Honor a `release-tag-date-scheme?' property?
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+\f
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test" "pre"))
+
+(define %pre-release-rx
+  (map (lambda (word)
+         (make-regexp (string-append ".+" word) regexp/icase))
+       %pre-release-words))
+
+(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
+  "Given a list of Git TAGS, return an association list where the car is the
+version corresponding to the tag, and the cdr is the name of the tag."
+  (define (guess-delimiter)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
+  (define suffix-rx  (string-append (or suffix "") "$"))
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (define pre-release-rx
+    (if pre-releases?
+        (string-append "(.*(" (string-join %pre-release-words "|") ").*)")
+        ""))
+
+  (define tag-rx
+    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
+                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                   ;; If there are no delimiters, it could mean that the
+                   ;; version just contains one number (e.g., "2"), thus, use
+                   ;; "*" instead of "+" to match zero or more numbers.
+                   (if (string=? delim-rx "") "*" "+") ")"
+                   ;; We don't want the pre-release stuff (e.g., "-alpha") be
+                   ;; part of the first group; otherwise, the "-" in "-alpha"
+                   ;; might be interpreted as a delimiter, and thus replaced
+                   ;; with "."
+                   pre-release-rx suffix-rx))
+
+
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (and=> (and tag-match
+                  (regexp-substitute/global
+                   #f delim-rx (match:substring tag-match 1)
+                   ;; If there were no delimiters, don't insert ".".
+                   'pre (if (string=? delim-rx "") "" ".") 'post))
+             (lambda (version)
+               (if pre-releases?
+                   (string-append version (match:substring tag-match 3))
+                   version)))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (stable-sort (filter-map (lambda (tag)
+                             (let ((version (get-version tag)))
+                               (and version (cons version tag))))
+                           tags)
+               entry<?))
+
+(define* (latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest version and corresponding tag available from the Git
+repository at URL."
+  (define (pre-release? tag)
+    (any (cut regexp-exec <> tag)
+         %pre-release-rx))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (remote-refs url #:tags? #t)))
+         (versions->tags
+          (version-mapping (if pre-releases?
+                               tags
+                               (filter (negate pre-release?) tags))
+                           #:prefix prefix
+                           #:suffix suffix
+                           #:delim delim
+                           #:pre-releases? pre-releases?)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package)
+  "Given a PACKAGE, return the latest version of it, or #f if the latest version
+could not be determined."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source)))
+           (property (cute assq-ref (package-properties package) <>)))
+      (latest-tag url
+                  #:prefix (property 'release-tag-prefix)
+                  #:suffix (property 'release-tag-suffix)
+                  #:delim (property 'release-tag-version-delimiter)
+                  #:pre-releases? (property 'accept-pre-releases?)))))
+
+(define (git-package? package)
+  "Return true if PACKAGE is hosted on a Git repository."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package)))
+
+    (and new-version
+         (upstream-source
+          (package name)
+          (version new-version)
+          (urls (list url))))))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62..d0646bbc85 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -161,4 +162,31 @@
               (commit-relation master1 merge)
               (commit-relation merge master1))))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs"
+  '("refs/heads/develop" "refs/heads/master"
+    "refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "release-1.0")
+        (branch "develop")
+        (checkout "develop")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "release-1.1"))
+    (remote-refs directory)))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs: only tags"
+ '("refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "Release 1.0")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "Release 1.1"))
+    (remote-refs directory #:tags? #t)))
+
 (test-end "git")
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 0000000000..f1bce154bb
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,245 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-import-git)
+  #:use-module (git)
+  #:use-module (guix git)
+  #:use-module (guix tests)
+  #:use-module (guix packages)
+  #:use-module (guix import git)
+  #:use-module (guix git-download)
+  #:use-module (guix tests git)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix import git) tools.
+
+(test-begin "git")
+
+(define* (make-package directory version #:optional (properties '()))
+  (dummy-package "test-package"
+    (version version)
+    (properties properties)
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url (string-append "file://" directory))
+             (commit version)))
+       (sha256
+        (base32
+         "0000000000000000000000000000000000000000000000000000"))))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix-1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "prefix-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1-suffix-123" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-suffix . "-suffix-[0-9]*")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
+  "2021.09.07"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2021-09-07" "Release 2021-09-07"))
+    (let ((package (make-package directory "2021-09-06"
+                                 '((release-tag-version-delimiter . "-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
+  "20210907"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "20210907" "Release 20210907"))
+    (let ((package (make-package directory "20210906"
+                                 '((release-tag-version-delimiter . "")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: only pre-releases available"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "version-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, delimiter conflicts with pre-release part"
+  "2.0.0_alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2_0_0_alpha" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2-0-0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")
+                                   (release-tag-version-delimiter . "-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, no delimiter, and custom suffix, prefix"
+  "2alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2alpha-suffix" "Alpha release for version 2"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")
+                                   (release-tag-version-delimiter . "")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no valid tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Test" "Test tag"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-end "git")
-- 
2.33.0







  parent reply	other threads:[~2021-09-17  8:07 UTC|newest]

Thread overview: 31+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-09-03 15:50 [bug#50359] [PATCH] import: Add 'generic-git' updater Xinglu Chen
2021-09-05  0:19 ` Sarah Morgensen
2021-09-05  1:03   ` Sarah Morgensen
2021-09-05 10:36   ` Xinglu Chen
2021-09-06  5:40     ` Sarah Morgensen
2021-09-06 12:20       ` Xinglu Chen
2021-09-07  1:00         ` Sarah Morgensen
2021-09-07 19:13           ` Xinglu Chen
2021-09-08 18:28             ` Xinglu Chen
2021-09-10  8:36               ` Ludovic Courtès
2021-09-10 13:23                 ` Xinglu Chen
2021-09-05 13:11   ` Xinglu Chen
2021-09-06  3:14     ` Sarah Morgensen
2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
2021-09-10 16:21   ` [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
2021-09-10 16:21   ` [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
2021-09-13  8:03     ` Ludovic Courtès
2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
2021-09-13  8:07     ` Ludovic Courtès
2021-09-16  9:09     ` Sarah Morgensen
2021-09-16 12:48       ` Xinglu Chen
2021-09-16 23:42         ` Sarah Morgensen
2021-09-17  7:48           ` Xinglu Chen
2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
2021-09-17  8:04     ` [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
2021-09-17  8:04     ` [bug#50359] [PATCH v3 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
2021-09-17  8:04     ` Xinglu Chen [this message]
2021-09-18 17:47     ` bug#50359: [PATCH v3 0/3] Add 'generic-git' updater Ludovic Courtès
2021-09-15  8:44 ` [bug#50359] [PATCH 3/3] import: " iskarian
2021-09-15 11:59   ` Xinglu Chen
2021-09-16  9:46     ` Sarah Morgensen

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=78cfc99b42371c9c21189f805030f11ca7e78861.1631865317.git.public@yoctocell.xyz \
    --to=public@yoctocell.xyz \
    --cc=50359@debbugs.gnu.org \
    --cc=iskarian@mgsn.dev \
    --cc=ludo@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).