unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Maxime Devos <maximedevos@telenet.be>
To: 53144@debbugs.gnu.org
Cc: Maxime Devos <maximedevos@telenet.be>
Subject: [bug#53144] [PATCH 10/13] upstream: Support incrementing the revision of 'git-version'.
Date: Sun,  9 Jan 2022 19:10:12 +0000	[thread overview]
Message-ID: <20220109191015.33058-10-maximedevos@telenet.be> (raw)
In-Reply-To: <20220109191015.33058-1-maximedevos@telenet.be>

This is currently pointless, because no updater returns such versions.
A future patch will introduce an updater returning such versions.

* guix/upstream.scm
  (git-version-regexp): New variable.
  (maybe-git-version, maybe-git-version->revision)
  (maybe-git-versions->revision-replacements): New procedures.
  (update-package-source): Use 'package-definition-location' instead of
  'package-location'.  Also replace the revision.
---
 guix/upstream.scm  | 61 +++++++++++++++++++++++++++++++++++++++++++++-
 tests/upstream.scm | 37 ++++++++++++++++++++++++++++
 2 files changed, 97 insertions(+), 1 deletion(-)

diff --git a/guix/upstream.scm b/guix/upstream.scm
index 6666803a92..6b65147356 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -61,6 +61,10 @@ (define-module (guix upstream)
             url-prefix-predicate
             coalesce-sources
 
+            decompose-git-version
+            maybe-git-version->revision
+            maybe-git-versions->revision-replacements ; for tests
+
             upstream-updater
             upstream-updater?
             upstream-updater-name
@@ -230,6 +234,55 @@ (define (release>? r1 r2)
         (sort sources release>?)))
 
 \f
+
+
+;;;
+;;; Manipulating results of 'git-version'.
+;;; TODO: also supporting Mercurial ('hg-version') would be nice.
+;;;
+
+;; A regexp matching versions constructed by 'git-version'.
+(define git-version-regexp
+  (delay (make-regexp "^(.+)-([0123456789]+).([0123456789abcdefg]{7})$")))
+
+(define (decompose-git-version git-version-string)
+  "Split the version string GIT-VERSION-STRING constructed by 'git-version'
+in three parts: the version it was based on, the revision (as a string)
+and the abbreviated commit.  If GIT-VERSION-STRING does not correspond
+to a result of 'git-version', return #false (three times) instead."
+  (define m (regexp-exec (force git-version-regexp) git-version-string))
+  (if m
+      (values (match:substring m 1)
+              (match:substring m 2)
+              (match:substring m 3))
+      (values #false #false #false)))
+
+(define (maybe-git-version->revision maybe-git-version) ; string | #false
+  "If the string MAYBE-GIT-VERSION appears to be the result of a call to
+'git-version', return the revision (as a string).  Otherwise, return #false."
+  (let-values (((version-base revision abbreviated-commit)
+                (decompose-git-version maybe-git-version)))
+    revision))
+
+(define (maybe-git-versions->revision-replacements old new)
+  "If the two strings OLD and NEW appear to be the result of a call
+to 'git-version', return a list of replacements as expected by
+'update-expression' in 'update-package-source' for updating the revision.
+Otherwise, return the empty list."
+  (let* ((old-revision (maybe-git-version->revision old))
+         (new-revision (maybe-git-version->revision new)))
+    (if (and old-revision new-revision)
+        ;; Simply returning ((old-revision . new-revision)) would work.
+        ;; However, revision numbers are usually quite small,
+        ;; e.g. "0" or "1", so that would have a high risk of replacing
+        ;; something unrelated.  Instead, target the (revision ...) form
+        ;; in (let ((commit ...) (revision ...)) (package ...)).
+        `((,(object->string `(revision ,old-revision))
+           . ,(object->string `(revision ,new-revision))))
+        '())))
+
+\f
+
 ;;;
 ;;; Auto-update.
 ;;;
@@ -535,7 +588,11 @@ (define (update-expression expr replacements)
         (version     (upstream-source-version source))
         (version-loc (package-field-location package 'version)))
     (if version-loc
-        (let* ((loc         (package-location package))
+        ;; Use 'package-definition-location' instead of 'package-location'
+        ;; such that the commit and revision in
+        ;; (let ((commit ...) (revision ...)) (package ...)) forms can
+        ;; be updated.
+        (let* ((loc         (package-definition-location package))
                (old-version (package-version package))
                (old-hash    (content-hash-value
                              (origin-hash (package-source package))))
@@ -570,6 +627,8 @@ (define (update-expression expr replacements)
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(maybe-git-versions->revision-replacements
+                                       old-version version)
                                     ,@(if (and old-commit new-commit)
                                           `((,old-commit . ,new-commit))
                                           '())
diff --git a/tests/upstream.scm b/tests/upstream.scm
index 9aacb77229..0b14b9867f 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@ (define-module (test-upstream)
   #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module (guix build-system gnu)
+  #:use-module (guix git-download)
   #:use-module (guix import print)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix upstream)
@@ -210,4 +212,39 @@ (define test-new-package-sexp
                     '("hello" "sed" "tar" "grep"))))
       (else (pk else #false)))))
 
+(define (decompose-git-version* str)
+  (call-with-values (lambda () (decompose-git-version str)) list))
+
+(test-equal "decompose-git-version returns arguments if commit is short"
+  '("1.2.3" "900" "cabba9e")
+  (decompose-git-version* "1.2.3-900.cabba9e"))
+
+(test-equal "decompose-git-version handles - in versions"
+  '("1.2.3-rc0" "123" "ba99a9e")
+  (decompose-git-version* "1.2.3-rc0-123.ba99a9e"))
+
+(test-equal "decompose-git-version returns #false if not a git-version result"
+  '(#false #false #false)
+  (decompose-git-version* "1.2.3-rc0.ba99a9e"))
+
+(test-equal "maybe-git-version->revision returns the revision"
+  "12"
+  (maybe-git-version->revision "1.2.3-12.ba99a9e"))
+
+(test-equal "maybe-git-version->revision returns #false if not a git-version"
+  #false
+  (maybe-git-version->revision "1.2.3-12.nope"))
+
+(test-equal "maybe-git-version->revision-replacement can return ()"
+  '(() () ())
+  (map maybe-git-versions->revision-replacements
+       '("1.2.3" "1.2.3" "1.2.3-21.cabba9e")
+       '("1.2.3" "1.2.3-21.cabba9e" "1.2.3")))
+
+(test-equal "maybe-git-version->revision-replacement with git-version"
+  '(("(revision \"0\")" . "(revision \"1\")"))
+  (maybe-git-versions->revision-replacements
+   (git-version "1.2.3" "0" "cabba9e")
+   (git-version "1.2.3" "1" "ba99age")))
+
 (test-end)
-- 
2.34.0





  parent reply	other threads:[~2022-01-09 19:13 UTC|newest]

Thread overview: 24+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-01-09 19:08 [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Maxime Devos
2022-01-09 19:10 ` [bug#53144] [PATCH 01/13] doc: Give some tips on Minetest packaging Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 02/13] gnu: minetest-ethereal: Follow new versioning conventions Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 03/13] gnu: minetest-mesecons: " Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 04/13] gnu: minetest-throwing: " Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 05/13] gnu: minetest: Remove obsolete comments about version numbers Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 06/13] gnu: minetest-ethereal: Update to 2022-01-05 Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 07/13] gnu: minetest-mesecons: Update to 2021-11-28 Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 08/13] gnu: minetest-mobs: Update to 2022-01-03 Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 09/13] doc: Document the Minetest importer Maxime Devos
2022-01-09 19:10   ` Maxime Devos [this message]
2022-01-18 17:33     ` [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Ludovic Courtès
2022-01-09 19:10   ` [bug#53144] [PATCH 11/13] git: Support resolving references without cloning Maxime Devos
2022-01-18 17:39     ` [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Ludovic Courtès
2022-04-03 11:47       ` Maxime Devos
2022-01-09 19:10   ` [bug#53144] [PATCH 12/13] import: Add 'latest-git' updater Maxime Devos
2022-01-18 17:45     ` [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Ludovic Courtès
2022-01-09 19:10   ` [bug#53144] [PATCH 13/13] gnu: minetest-throwing-arrows: Use 'latest-git' updater Maxime Devos
2022-01-09 21:15   ` [bug#53144] [PATCH 01/13] doc: Give some tips on Minetest packaging Liliana Marie Prikler
2022-01-09 23:29     ` Maxime Devos
2022-01-10 21:29       ` Liliana Marie Prikler
2022-01-18 17:30   ` [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Ludovic Courtès
     [not found] ` <handler.53144.B.164175531629466.ack@debbugs.gnu.org>
2022-01-09 19:49   ` [bug#53144] Acknowledgement ([PATCH 0/13] Make more git-using packages auto-updatable) Maxime Devos
2022-06-06 15:15 ` [bug#53144] [PATCH 0/13] Make more git-using packages auto-updatable Maxime Devos

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=20220109191015.33058-10-maximedevos@telenet.be \
    --to=maximedevos@telenet.be \
    --cc=53144@debbugs.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).