From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id gHDqJLZMRGGbkwAAgWs5BA (envelope-from ) for ; Fri, 17 Sep 2021 10:07:18 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id GLGEILZMRGEJawAAB5/wlQ (envelope-from ) for ; Fri, 17 Sep 2021 08:07:18 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id DA4A0FFB0 for ; Fri, 17 Sep 2021 10:07:17 +0200 (CEST) Received: from localhost ([::1]:48158 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mR8tw-0005Fe-VI for larch@yhetil.org; Fri, 17 Sep 2021 04:07:16 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:41026) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mR8rn-0003c5-Nj for guix-patches@gnu.org; Fri, 17 Sep 2021 04:05:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46860) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mR8rn-0007kl-Fx for guix-patches@gnu.org; Fri, 17 Sep 2021 04:05:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mR8rn-0001Lx-Av for guix-patches@gnu.org; Fri, 17 Sep 2021 04:05:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater. Resent-From: Xinglu Chen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Sep 2021 08:05:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50359 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50359@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Sarah Morgensen Received: via spool by 50359-submit@debbugs.gnu.org id=B50359.16318659015169 (code B ref 50359); Fri, 17 Sep 2021 08:05:03 +0000 Received: (at 50359) by debbugs.gnu.org; 17 Sep 2021 08:05:01 +0000 Received: from localhost ([127.0.0.1]:58403 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mR8rk-0001LI-1I for submit@debbugs.gnu.org; Fri, 17 Sep 2021 04:05:01 -0400 Received: from h87-96-130-155.cust.a3fiber.se ([87.96.130.155]:32770 helo=mail.yoctocell.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mR8rh-0001Kr-Iu for 50359@debbugs.gnu.org; Fri, 17 Sep 2021 04:04:58 -0400 From: Xinglu Chen DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=yoctocell.xyz; s=mail; t=1631865890; bh=D+CxAc00K/mVZ8z7HTG3jJ/4j5dpwTNXJ80qjLI5fiQ=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=lm099p7P3vnGrQL8yp0BDioakvkQRa0hNlPfz+z7mlWgIurd3t7ALGevxKavLjCHs eXTZ7oYJXK69A7eEYEF7ELt72xfvNitDnbV0uNXmFmkMDsGsvTwWkAxBfrFuZL3Ed4 nlWyUy1PdegTW9VYKEFV5nEBtJbubB0BAO+bheyM= In-Reply-To: References: Message-Id: <78cfc99b42371c9c21189f805030f11ca7e78861.1631865317.git.public@yoctocell.xyz> Date: Fri, 17 Sep 2021 10:04:49 +0200 MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1631866038; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=glQwh/mIxUABNrHJKi2mHZ2wqMP1GKSow4C2RiMQsRM=; b=DIegzWWviXmJnw+Vl98hc21GSdWN7LufA+DKtwp+ta4sndZHuI+NeHnl3ji4fCVV5W6kqc XXnf9Henk/sCZWGg1yAJqzrnX3zt2TmWnY84PXJPVxKb+B7GG6x5tyjJlD9w6Bxrssd4Iz 7Wz4tFwMomrlkjsilV32kiOcjC9yYNw9c8PII4b7TsyJH4uxit8kI8edYP0BeQgkXMKjlF 3Zjn5rVxcqVC8TkStkGFeBX8JEL3TFYED4QtjJ5uJxOBBTlEA4qE5qWdlwaWGERVfX58HI wDyHrUq/yr8mf1tKXuwtC1gajlgHkeTCIQJCEPxoMtzg/+QsrccxElxlY34uig== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1631866038; a=rsa-sha256; cv=none; b=bKfcvXipMc39OMLGiIUZZfe/obN5pZW+xSzf9/1FQnMQzmVerIkfWV8TOTT2BdWjUTmFHm 9MDusWIc2LixtXOHq0Wt9/LxSUtcaqcabuNc+mNibtGUC3X6T6sXe+VS5KjTygiZkZFr1r 6MSslfBzebCtpTGVE8tP4Z4JBEB1GTVrfcoRd4vfTf1hGck5cm42aIi3+wPiU43yX+XjnK JN8mdqMej7Ji/ACgCutOKO0Fyn8IvLcsu4YzHIAboDSW5jM0+vrYRQ/j4LrKpIDuBSO9ro hssww+6UWBsenQLICn4ln9ZkzO5IU+KYO9CUYo6v8AvJ5r6g5MhA/J4/6WFpyQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=yoctocell.xyz header.s=mail header.b=lm099p7P; dmarc=fail reason="SPF not aligned (relaxed)" header.from=yoctocell.xyz (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -0.30 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=yoctocell.xyz header.s=mail header.b=lm099p7P; dmarc=fail reason="SPF not aligned (relaxed)" header.from=yoctocell.xyz (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: DA4A0FFB0 X-Spam-Score: -0.30 X-Migadu-Scanner: scn0.migadu.com X-TUID: LXcQgFRplTrq * 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 --- 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 =3D \ 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 =3D \ 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, Launc= hpad} 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 prefi= x of +the tag name. + +@item @code{release-tag-suffix}: a regular expression for matching a suffi= x 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 =20 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 =20 + 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)))))) + +;; +;;; Remote operations. +;;; + +(define* (remote-refs url #:key tags?) + "Return the list of references advertised at Git repository URL. If TAG= S? +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)))))) =20 ;;; 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 =C2=A9 2021 Xinglu Chen +;;; Copyright =C2=A9 2021 Sarah Morgensen +;;; +;;; 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 . + +(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 a= ble +;;; to parse the tag names correctly, users can set the `release-tag-prefi= x', +;;; `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)))) + + +;;; 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 t= he +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 + ((>=3D dots (* total 0.35)) ".") + ((>=3D dashes (* total 0.8)) "-") + ((>=3D 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=3D? delim-rx "") "*" "+") ")" + ;; We don't want the pre-release stuff (e.g., "-alpha")= be + ;; part of the first group; otherwise, the "-" in "-alp= ha" + ;; might be interpreted as a delimiter, and thus replac= ed + ;; with "." + pre-release-rx suffix-rx)) + + + + (define (get-version tag) + (let ((tag-match (regexp-exec (make-regexp tag-rx) tag))) + (and=3D> (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=3D? delim-rx "") "" ".") 'post)) + (lambda (version) + (if pre-releases? + (string-append version (match:substring tag-match 3)) + version))))) + + (define (entry 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 v= ersion +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 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 =C2=A9 2019, 2020 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2021 Xinglu Chen . + +(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 delimit= er" + "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 delimite= r" + "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 delimite= r" + "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 suffi= x" + "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 delimite= r" + "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 prefi= x" + "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 suffi= x" + "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 confli= cts 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 suffi= x 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 suffi= x, 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, an= d 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") --=20 2.33.0