@@ -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>?)))
+
+
+;;;
+;;; 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))))
+ '())))
+
+
+
;;;
;;; 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))
'())
@@ -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)