summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorXinglu Chen <public@yoctocell.xyz>2021-09-17 10:04:49 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-18 19:37:45 +0200
commit59ee10754eddddb99e4a80b9e18aa12ed1b3d77a (patch)
tree0e5b7e9961218577b7b4f8dcf682f8fec3403cc9
parent6597f80839142cd341cbf6cee2f34eaf4de14533 (diff)
import: Add 'generic-git' updater.
* 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> Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r--Makefile.am2
-rw-r--r--doc/guix.texi34
-rw-r--r--guix/git.scm41
-rw-r--r--guix/import/git.scm225
-rw-r--r--tests/git.scm28
-rw-r--r--tests/import-git.scm245
6 files changed, 575 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 299bc0f7fba..f3bdc7448ea 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES = \
254 guix/import/egg.scm \ 254 guix/import/egg.scm \
255 guix/import/elpa.scm \ 255 guix/import/elpa.scm \
256 guix/import/gem.scm \ 256 guix/import/gem.scm \
257 guix/import/git.scm \
257 guix/import/github.scm \ 258 guix/import/github.scm \
258 guix/import/gnome.scm \ 259 guix/import/gnome.scm \
259 guix/import/gnu.scm \ 260 guix/import/gnu.scm \
@@ -473,6 +474,7 @@ SCM_TESTS = \
473 tests/graph.scm \ 474 tests/graph.scm \
474 tests/gremlin.scm \ 475 tests/gremlin.scm \
475 tests/hackage.scm \ 476 tests/hackage.scm \
477 tests/import-git.scm \
476 tests/import-utils.scm \ 478 tests/import-utils.scm \
477 tests/inferior.scm \ 479 tests/inferior.scm \
478 tests/lint.scm \ 480 tests/lint.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 2fc96879106..6436e83a7c8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11928,6 +11928,40 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
11928@item generic-html 11928@item generic-html
11929a generic updater that crawls the HTML page where the source tarball of 11929a generic updater that crawls the HTML page where the source tarball of
11930the package is hosted, when applicable. 11930the package is hosted, when applicable.
11931
11932@item generic-git
11933a generic updater for packages hosted on Git repositories. It tries to
11934be smart about parsing Git tag names, but if it is not able to parse the
11935tag name and compare tags correctly, users can define the following
11936properties for a package.
11937
11938@itemize
11939@item @code{release-tag-prefix}: a regular expression for matching a prefix of
11940the tag name.
11941
11942@item @code{release-tag-suffix}: a regular expression for matching a suffix of
11943the tag name.
11944
11945@item @code{release-tag-version-delimiter}: a string used as the delimiter in
11946the tag name for separating the numbers of the version.
11947
11948@item @code{accept-pre-releases}: by default, the updater will ignore
11949pre-releases; to make it also look for pre-releases, set the this
11950property to @code{#t}.
11951
11952@end itemize
11953
11954@lisp
11955(package
11956 (name "foo")
11957 ;; ...
11958 (properties
11959 '((release-tag-prefix . "^release0-")
11960 (release-tag-suffix . "[a-z]?$")
11961 (release-tag-version-delimiter . ":"))))
11962@end lisp
11963
11964
11931@end table 11965@end table
11932 11966
11933For instance, the following command only checks for updates of Emacs 11967For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f5..bbff4fc8907 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -57,6 +57,8 @@
57 commit-difference 57 commit-difference
58 commit-relation 58 commit-relation
59 59
60 remote-refs
61
60 git-checkout 62 git-checkout
61 git-checkout? 63 git-checkout?
62 git-checkout-url 64 git-checkout-url
@@ -571,6 +573,45 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
571 (if (set-contains? oldest new) 573 (if (set-contains? oldest new)
572 'descendant 574 'descendant
573 'unrelated)))))) 575 'unrelated))))))
576
577;;
578;;; Remote operations.
579;;;
580
581(define* (remote-refs url #:key tags?)
582 "Return the list of references advertised at Git repository URL. If TAGS?
583is true, limit to only refs/tags."
584 (define (ref? ref)
585 ;; Like `git ls-remote --refs', only show actual references.
586 (and (string-prefix? "refs/" ref)
587 (not (string-suffix? "^{}" ref))))
588
589 (define (tag? ref)
590 (string-prefix? "refs/tags/" ref))
591
592 (define (include? ref)
593 (and (ref? ref)
594 (or (not tags?) (tag? ref))))
595
596 (define (remote-head->ref remote)
597 (let ((name (remote-head-name remote)))
598 (and (include? name)
599 name)))
600
601 (with-libgit2
602 (call-with-temporary-directory
603 (lambda (cache-directory)
604 (let* ((repository (repository-init cache-directory))
605 ;; Create an in-memory remote so we don't touch disk.
606 (remote (remote-create-anonymous repository url)))
607 (remote-connect remote)
608
609 (let* ((remote-heads (remote-ls remote))
610 (refs (filter-map remote-head->ref remote-heads)))
611 ;; Wait until we're finished with the repository before closing it.
612 (remote-disconnect remote)
613 (repository-close! repository)
614 refs))))))
574 615
575 616
576;;; 617;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 00000000000..1eb219f3fe2
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,225 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
3;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (guix import git)
21 #:use-module (guix build utils)
22 #:use-module (guix diagnostics)
23 #:use-module (guix git)
24 #:use-module (guix git-download)
25 #:use-module (guix i18n)
26 #:use-module (guix packages)
27 #:use-module (guix upstream)
28 #:use-module (guix utils)
29 #:use-module (ice-9 format)
30 #:use-module (ice-9 match)
31 #:use-module (ice-9 rdelim)
32 #:use-module (ice-9 regex)
33 #:use-module (srfi srfi-1)
34 #:use-module (srfi srfi-26)
35 #:use-module (srfi srfi-34)
36 #:use-module (srfi srfi-35)
37 #:export (%generic-git-updater
38
39 ;; For tests.
40 latest-git-tag-version))
41
42;;; Commentary:
43;;;
44;;; This module provides a generic package updater for packages hosted on Git
45;;; repositories.
46;;;
47;;; It tries to be smart about tag names, but if it is not automatically able
48;;; to parse the tag names correctly, users can set the `release-tag-prefix',
49;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
50;;; package to make the updater parse the Git tag name correctly.
51;;;
52;;; Possible improvements:
53;;;
54;;; * More robust method for trying to guess the delimiter. Maybe look at the
55;;; previous version/tag combo to determine the delimiter.
56;;;
57;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g.,
58;;; 2021.12.31. Honor a `release-tag-date-scheme?' property?
59;;;
60;;; Code:
61
62;;; Errors & warnings
63
64(define-condition-type &git-no-valid-tags-error &error
65 git-no-valid-tags-error?)
66
67(define (git-no-valid-tags-error)
68 (raise (condition (&message (message "no valid tags found"))
69 (&git-no-valid-tags-error))))
70
71(define-condition-type &git-no-tags-error &error
72 git-no-tags-error?)
73
74(define (git-no-tags-error)
75 (raise (condition (&message (message "no tags were found"))
76 (&git-no-tags-error))))
77
78
79;;; Updater
80
81(define %pre-release-words
82 '("alpha" "beta" "rc" "dev" "test" "pre"))
83
84(define %pre-release-rx
85 (map (lambda (word)
86 (make-regexp (string-append ".+" word) regexp/icase))
87 %pre-release-words))
88
89(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
90 "Given a list of Git TAGS, return an association list where the car is the
91version corresponding to the tag, and the cdr is the name of the tag."
92 (define (guess-delimiter)
93 (let ((total (length tags))
94 (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
95 (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
96 (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
97 (cond
98 ((>= dots (* total 0.35)) ".")
99 ((>= dashes (* total 0.8)) "-")
100 ((>= underscores (* total 0.8)) "_")
101 (else ""))))
102
103 (define delim-rx (regexp-quote (or delim (guess-delimiter))))
104 (define suffix-rx (string-append (or suffix "") "$"))
105 (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
106 (define pre-release-rx
107 (if pre-releases?
108 (string-append "(.*(" (string-join %pre-release-words "|") ").*)")
109 ""))
110
111 (define tag-rx
112 (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
113 "(" delim-rx "[^[:punct:]" delim-rx "]+)"
114 ;; If there are no delimiters, it could mean that the
115 ;; version just contains one number (e.g., "2"), thus, use
116 ;; "*" instead of "+" to match zero or more numbers.
117 (if (string=? delim-rx "") "*" "+") ")"
118 ;; We don't want the pre-release stuff (e.g., "-alpha") be
119 ;; part of the first group; otherwise, the "-" in "-alpha"
120 ;; might be interpreted as a delimiter, and thus replaced
121 ;; with "."
122 pre-release-rx suffix-rx))
123
124
125
126 (define (get-version tag)
127 (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
128 (and=> (and tag-match
129 (regexp-substitute/global
130 #f delim-rx (match:substring tag-match 1)
131 ;; If there were no delimiters, don't insert ".".
132 'pre (if (string=? delim-rx "") "" ".") 'post))
133 (lambda (version)
134 (if pre-releases?
135 (string-append version (match:substring tag-match 3))
136 version)))))
137
138 (define (entry<? a b)
139 (eq? (version-compare (car a) (car b)) '<))
140
141 (stable-sort (filter-map (lambda (tag)
142 (let ((version (get-version tag)))
143 (and version (cons version tag))))
144 tags)
145 entry<?))
146
147(define* (latest-tag url #:key prefix suffix delim pre-releases?)
148 "Return the latest version and corresponding tag available from the Git
149repository at URL."
150 (define (pre-release? tag)
151 (any (cut regexp-exec <> tag)
152 %pre-release-rx))
153
154 (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
155 (remote-refs url #:tags? #t)))
156 (versions->tags
157 (version-mapping (if pre-releases?
158 tags
159 (filter (negate pre-release?) tags))
160 #:prefix prefix
161 #:suffix suffix
162 #:delim delim
163 #:pre-releases? pre-releases?)))
164 (cond
165 ((null? tags)
166 (git-no-tags-error))
167 ((null? versions->tags)
168 (git-no-valid-tags-error))
169 (else
170 (match (last versions->tags)
171 ((version . tag)
172 (values version tag)))))))
173
174(define (latest-git-tag-version package)
175 "Given a PACKAGE, return the latest version of it, or #f if the latest version
176could not be determined."
177 (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
178 (warning (or (package-field-location package 'source)
179 (package-location package))
180 (G_ "~a for ~a~%")
181 (condition-message c)
182 (package-name package))
183 #f)
184 ((eq? (exception-kind c) 'git-error)
185 (warning (or (package-field-location package 'source)
186 (package-location package))
187 (G_ "failed to fetch Git repository for ~a~%")
188 (package-name package))
189 #f))
190 (let* ((source (package-source package))
191 (url (git-reference-url (origin-uri source)))
192 (property (cute assq-ref (package-properties package) <>)))
193 (latest-tag url
194 #:prefix (property 'release-tag-prefix)
195 #:suffix (property 'release-tag-suffix)
196 #:delim (property 'release-tag-version-delimiter)
197 #:pre-releases? (property 'accept-pre-releases?)))))
198
199(define (git-package? package)
200 "Return true if PACKAGE is hosted on a Git repository."
201 (match (package-source package)
202 ((? origin? origin)
203 (and (eq? (origin-method origin) git-fetch)
204 (git-reference? (origin-uri origin))))
205 (_ #f)))
206
207(define (latest-git-release package)
208 "Return an <upstream-source> for the latest release of PACKAGE."
209 (let* ((name (package-name package))
210 (old-version (package-version package))
211 (url (git-reference-url (origin-uri (package-source package))))
212 (new-version (latest-git-tag-version package)))
213
214 (and new-version
215 (upstream-source
216 (package name)
217 (version new-version)
218 (urls (list url))))))
219
220(define %generic-git-updater
221 (upstream-updater
222 (name 'generic-git)
223 (description "Updater for packages hosted on Git repositories")
224 (pred git-package?)
225 (latest latest-git-release)))
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62c..d0646bbc85b 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
3;;; 4;;;
4;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
5;;; 6;;;
@@ -161,4 +162,31 @@
161 (commit-relation master1 merge) 162 (commit-relation master1 merge)
162 (commit-relation merge master1)))))) 163 (commit-relation merge master1))))))
163 164
165(unless (which (git-command)) (test-skip 1))
166(test-equal "remote-refs"
167 '("refs/heads/develop" "refs/heads/master"
168 "refs/tags/v1.0" "refs/tags/v1.1")
169 (with-temporary-git-repository directory
170 '((add "a.txt" "A")
171 (commit "First commit")
172 (tag "v1.0" "release-1.0")
173 (branch "develop")
174 (checkout "develop")
175 (add "b.txt" "B")
176 (commit "Second commit")
177 (tag "v1.1" "release-1.1"))
178 (remote-refs directory)))
179
180(unless (which (git-command)) (test-skip 1))
181(test-equal "remote-refs: only tags"
182 '("refs/tags/v1.0" "refs/tags/v1.1")
183 (with-temporary-git-repository directory
184 '((add "a.txt" "A")
185 (commit "First commit")
186 (tag "v1.0" "Release 1.0")
187 (add "b.txt" "B")
188 (commit "Second commit")
189 (tag "v1.1" "Release 1.1"))
190 (remote-refs directory #:tags? #t)))
191
164(test-end "git") 192(test-end "git")
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 00000000000..f1bce154bb2
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,245 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (test-import-git)
20 #:use-module (git)
21 #:use-module (guix git)
22 #:use-module (guix tests)
23 #:use-module (guix packages)
24 #:use-module (guix import git)
25 #:use-module (guix git-download)
26 #:use-module (guix tests git)
27 #:use-module (guix build utils)
28 #:use-module (srfi srfi-1)
29 #:use-module (srfi srfi-64))
30
31;; Test the (guix import git) tools.
32
33(test-begin "git")
34
35(define* (make-package directory version #:optional (properties '()))
36 (dummy-package "test-package"
37 (version version)
38 (properties properties)
39 (source
40 (origin
41 (method git-fetch)
42 (uri (git-reference
43 (url (string-append "file://" directory))
44 (commit version)))
45 (sha256
46 (base32
47 "0000000000000000000000000000000000000000000000000000"))))))
48
49(unless (which (git-command)) (test-skip 1))
50(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
51 "1.0.1"
52 (with-temporary-git-repository directory
53 '((add "a.txt" "A")
54 (commit "First commit")
55 (tag "1.0.1" "Release 1.0.1"))
56 (let ((package (make-package directory "1.0.0")))
57 (latest-git-tag-version package))))
58
59(unless (which (git-command)) (test-skip 1))
60(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
61 "1.0.1"
62 (with-temporary-git-repository directory
63 '((add "a.txt" "A")
64 (commit "First commit")
65 (tag "prefix-1.0.1" "Release 1.0.1"))
66 (let ((package (make-package directory "1.0.0"
67 '((release-tag-prefix . "prefix-")))))
68 (latest-git-tag-version package))))
69
70(unless (which (git-command)) (test-skip 1))
71(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
72 "1.0.1"
73 (with-temporary-git-repository directory
74 '((add "a.txt" "A")
75 (commit "First commit")
76 (tag "1.0.1-suffix-123" "Release 1.0.1"))
77 (let ((package (make-package directory "1.0.0"
78 '((release-tag-suffix . "-suffix-[0-9]*")))))
79 (latest-git-tag-version package))))
80
81(unless (which (git-command)) (test-skip 1))
82(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
83 "2021.09.07"
84 (with-temporary-git-repository directory
85 '((add "a.txt" "A")
86 (commit "First commit")
87 (tag "2021-09-07" "Release 2021-09-07"))
88 (let ((package (make-package directory "2021-09-06"
89 '((release-tag-version-delimiter . "-")))))
90 (latest-git-tag-version package))))
91
92(unless (which (git-command)) (test-skip 1))
93(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
94 "20210907"
95 (with-temporary-git-repository directory
96 '((add "a.txt" "A")
97 (commit "First commit")
98 (tag "20210907" "Release 20210907"))
99 (let ((package (make-package directory "20210906"
100 '((release-tag-version-delimiter . "")))))
101 (latest-git-tag-version package))))
102
103(unless (which (git-command)) (test-skip 1))
104(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
105 "2.0.0"
106 (with-temporary-git-repository directory
107 '((add "a.txt" "A")
108 (commit "First commit")
109 (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
110 (let ((package (make-package directory "1.0.0"
111 '((release-tag-prefix . "Release-")
112 (release-tag-suffix . "suffix-[0-9]")))))
113 (latest-git-tag-version package))))
114
115(unless (which (git-command)) (test-skip 1))
116(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
117 "2.0.0"
118 (with-temporary-git-repository directory
119 '((add "a.txt" "A")
120 (commit "First commit")
121 (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
122 (let ((package (make-package directory "1.0.0"
123 '((release-tag-prefix . "Release-")
124 (release-tag-suffix . "suffix-[0-9]")
125 (release-tag-version-delimiter . "_")))))
126 (latest-git-tag-version package))))
127
128(unless (which (git-command)) (test-skip 1))
129(test-equal "latest-git-tag-version: only pre-releases available"
130 #f
131 (with-temporary-git-repository directory
132 '((add "a.txt" "A")
133 (commit "First commit")
134 (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
135 (let ((package (make-package directory "1.0.0")))
136 (latest-git-tag-version package))))
137
138(unless (which (git-command)) (test-skip 1))
139(test-equal "latest-git-tag-version: accept pre-releases"
140 "2.0.0-rc1"
141 (with-temporary-git-repository directory
142 '((add "a.txt" "A")
143 (commit "First commit")
144 (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
145 (let ((package (make-package directory "1.0.0"
146 '((accept-pre-releases? . #t)))))
147 (latest-git-tag-version package))))
148
149(unless (which (git-command)) (test-skip 1))
150(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
151 "2.0.0-rc1"
152 (with-temporary-git-repository directory
153 '((add "a.txt" "A")
154 (commit "First commit")
155 (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
156 (let ((package (make-package directory "1.0.0"
157 '((accept-pre-releases? . #t)
158 (release-tag-prefix . "version-")))))
159 (latest-git-tag-version package))))
160
161(unless (which (git-command)) (test-skip 1))
162(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
163 "2.0.0-rc1"
164 (with-temporary-git-repository directory
165 '((add "a.txt" "A")
166 (commit "First commit")
167 (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
168 (let ((package (make-package directory "1.0.0"
169 '((accept-pre-releases? . #t)
170 (release-tag-suffix . "-suffix")))))
171 (latest-git-tag-version package))))
172
173(unless (which (git-command)) (test-skip 1))
174(test-equal "latest-git-tag-version: accept pre-releases, delimiter conflicts with pre-release part"
175 "2.0.0_alpha"
176 (with-temporary-git-repository directory
177 '((add "a.txt" "A")
178 (commit "First commit")
179 (tag "2_0_0_alpha" "Alpha release for 2.0.0"))
180 (let ((package (make-package directory "1.0.0"
181 '((accept-pre-releases? . #t)
182 (release-tag-version-delimiter . "_")))))
183 (latest-git-tag-version package))))
184
185(unless (which (git-command)) (test-skip 1))
186(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
187 "2.0.0-alpha"
188 (with-temporary-git-repository directory
189 '((add "a.txt" "A")
190 (commit "First commit")
191 (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
192 (let ((package (make-package directory "1.0.0"
193 '((accept-pre-releases? . #t)
194 (release-tag-prefix . "prefix[0-9]{3}-")
195 (release-tag-suffix . "-suffix")))))
196 (latest-git-tag-version package))))
197
198(unless (which (git-command)) (test-skip 1))
199(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
200 "2.0.0-alpha"
201 (with-temporary-git-repository directory
202 '((add "a.txt" "A")
203 (commit "First commit")
204 (tag "prefix123-2-0-0-alpha-suffix" "Alpha release for 2.0.0"))
205 (let ((package (make-package directory "1.0.0"
206 '((accept-pre-releases? . #t)
207 (release-tag-prefix . "prefix[0-9]{3}-")
208 (release-tag-suffix . "-suffix")
209 (release-tag-version-delimiter . "-")))))
210 (latest-git-tag-version package))))
211
212(unless (which (git-command)) (test-skip 1))
213(test-equal "latest-git-tag-version: accept pre-releases, no delimiter, and custom suffix, prefix"
214 "2alpha"
215 (with-temporary-git-repository directory
216 '((add "a.txt" "A")
217 (commit "First commit")
218 (tag "prefix123-2alpha-suffix" "Alpha release for version 2"))
219 (let ((package (make-package directory "1.0.0"
220 '((accept-pre-releases? . #t)
221 (release-tag-prefix . "prefix[0-9]{3}-")
222 (release-tag-suffix . "-suffix")
223 (release-tag-version-delimiter . "")))))
224 (latest-git-tag-version package))))
225
226(unless (which (git-command)) (test-skip 1))
227(test-equal "latest-git-tag-version: no tags found"
228 #f
229 (with-temporary-git-repository directory
230 '((add "a.txt" "A")
231 (commit "First commit"))
232 (let ((package (make-package directory "1.0.0")))
233 (latest-git-tag-version package))))
234
235(unless (which (git-command)) (test-skip 1))
236(test-equal "latest-git-tag-version: no valid tags found"
237 #f
238 (with-temporary-git-repository directory
239 '((add "a.txt" "A")
240 (commit "First commit")
241 (tag "Test" "Test tag"))
242 (let ((package (make-package directory "1.0.0")))
243 (latest-git-tag-version package))))
244
245(test-end "git")