[bug#74542] [PATCH v2 14/16] transformations: ‘package-with-upstream-version’ can preserve patches.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/transformations.scm (upstream-fetch): New procedure.
(package-with-upstream-version): Add #:preserve-patches? and honor it.

Change-Id: Ib56b84957d8bdad2eebe2551e2a6e477506fc55e
---
 guix/transformations.scm  | 25 ++++++++++++++++++++++---
 tests/transformations.scm | 31 ++++++++++++++++++++++++++++++-
 2 files changed, 52 insertions(+), 4 deletions(-)

diff --git a/guix/transformations.scm b/guix/transformations.scm
index 9dfc4402c5..a32aad39f2 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -848,9 +848,20 @@ (define (transform-package-patches specs)
         (rewrite obj)
         obj)))
 
-(define* (package-with-upstream-version p #:optional version)
+(define* (upstream-fetch source hash-algo hash
+                         #:optional name
+                         #:key (system (%current-system))
+                         (guile (default-guile))
+                         executable?)
+  "This origin method simply downloads SOURCE, an <upstream-source> record."
+  (lower-object source system))
+
+(define* (package-with-upstream-version p #:optional version
+                                        #:key (preserve-patches? #f))
   "Return package P changed to use the given upstream VERSION or, if VERSION
-is #f, the latest known upstream version."
+is #f, the latest known upstream version.  When PRESERVE-PATCHES? is true,
+preserve patches and snippets found in the source of P, provided it's an
+origin."
   (let ((source (package-latest-release p #:version version)))
     (cond ((not source)
            (if version
@@ -885,7 +896,15 @@ (define* (package-with-upstream-version p #:optional version)
            (package
              (inherit p)
              (version (upstream-source-version source))
-             (source source))))))
+             (source (if (and preserve-patches?
+                              (origin? (package-source p)))
+                         ;; Inherit P's origin so snippets and patches are
+                         ;; applied as if we had run 'guix refresh -u'.
+                         (origin
+                           (inherit (package-source p))
+                           (method upstream-fetch)
+                           (uri source))
+                         source)))))))
 
 (define (transform-package-latest specs)
   "Return a procedure that rewrites package graphs such that those in SPECS
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 755211d65d..5285d98f17 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2017, 2019-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -497,6 +497,35 @@ (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain"))
     (let ((new (t coreutils)))
       (assq-ref (package-properties new) 'transformations))))
 
+(test-equal "package-with-upstream-version"
+  '("42.0" "42.0"
+    ("http://example.org")
+    ("a" "b") (do something))
+  (mock ((guix upstream) %updaters
+         (delay (list (upstream-updater
+                       (name 'dummy)
+                       (pred (const #t))
+                       (description "")
+                       (import (const (upstream-source
+                                       (package "foo")
+                                       (version "42.0")
+                                       (urls '("http://example.org")))))))))
+        (let* ((old (dummy-package "foo" (version "1.0")
+                                   (source (dummy-origin
+                                            (patches '("a" "b"))
+                                            (snippet '(do something))))))
+               (new (package-with-upstream-version old))
+               (new+patches (package-with-upstream-version
+                             old #:preserve-patches? #t)))
+          (list (package-version new) (package-version new+patches)
+
+                ;; Source of NEW is directly an <upstream-source>.
+                (upstream-source-urls (package-source new))
+
+                ;; Check that #:preserve-patches? #t gave us an origin.
+                (origin-patches (package-source new+patches))
+                (origin-snippet (package-source new+patches))))))
+
 (test-equal "options->transformation, with-latest"
   "42.0"
   (mock ((guix upstream) %updaters
-- 
2.46.0