diff options
| -rw-r--r-- | guix/transformations.scm | 25 | ||||
| -rw-r--r-- | tests/transformations.scm | 31 |
2 files changed, 52 insertions, 4 deletions
diff --git a/guix/transformations.scm b/guix/transformations.scm index 9dfc4402c5c..a32aad39f28 100644 --- a/guix/transformations.scm +++ b/guix/transformations.scm | |||
| @@ -848,9 +848,20 @@ additional patches." | |||
| 848 | (rewrite obj) | 848 | (rewrite obj) |
| 849 | obj))) | 849 | obj))) |
| 850 | 850 | ||
| 851 | (define* (package-with-upstream-version p #:optional version) | 851 | (define* (upstream-fetch source hash-algo hash |
| 852 | #:optional name | ||
| 853 | #:key (system (%current-system)) | ||
| 854 | (guile (default-guile)) | ||
| 855 | executable?) | ||
| 856 | "This origin method simply downloads SOURCE, an <upstream-source> record." | ||
| 857 | (lower-object source system)) | ||
| 858 | |||
| 859 | (define* (package-with-upstream-version p #:optional version | ||
| 860 | #:key (preserve-patches? #f)) | ||
| 852 | "Return package P changed to use the given upstream VERSION or, if VERSION | 861 | "Return package P changed to use the given upstream VERSION or, if VERSION |
| 853 | is #f, the latest known upstream version." | 862 | is #f, the latest known upstream version. When PRESERVE-PATCHES? is true, |
| 863 | preserve patches and snippets found in the source of P, provided it's an | ||
| 864 | origin." | ||
| 854 | (let ((source (package-latest-release p #:version version))) | 865 | (let ((source (package-latest-release p #:version version))) |
| 855 | (cond ((not source) | 866 | (cond ((not source) |
| 856 | (if version | 867 | (if version |
| @@ -885,7 +896,15 @@ version (~a)~%") | |||
| 885 | (package | 896 | (package |
| 886 | (inherit p) | 897 | (inherit p) |
| 887 | (version (upstream-source-version source)) | 898 | (version (upstream-source-version source)) |
| 888 | (source source)))))) | 899 | (source (if (and preserve-patches? |
| 900 | (origin? (package-source p))) | ||
| 901 | ;; Inherit P's origin so snippets and patches are | ||
| 902 | ;; applied as if we had run 'guix refresh -u'. | ||
| 903 | (origin | ||
| 904 | (inherit (package-source p)) | ||
| 905 | (method upstream-fetch) | ||
| 906 | (uri source)) | ||
| 907 | source))))))) | ||
| 889 | 908 | ||
| 890 | (define (transform-package-latest specs) | 909 | (define (transform-package-latest specs) |
| 891 | "Return a procedure that rewrites package graphs such that those in SPECS | 910 | "Return a procedure that rewrites package graphs such that those in SPECS |
diff --git a/tests/transformations.scm b/tests/transformations.scm index 755211d65d9..5285d98f17e 100644 --- a/tests/transformations.scm +++ b/tests/transformations.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2016-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2016-2017, 2019-2024 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2021 Marius Bakke <marius@gnu.org> | 3 | ;;; Copyright © 2021 Marius Bakke <marius@gnu.org> |
| 4 | ;;; | 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| @@ -497,6 +497,35 @@ | |||
| 497 | (let ((new (t coreutils))) | 497 | (let ((new (t coreutils))) |
| 498 | (assq-ref (package-properties new) 'transformations)))) | 498 | (assq-ref (package-properties new) 'transformations)))) |
| 499 | 499 | ||
| 500 | (test-equal "package-with-upstream-version" | ||
| 501 | '("42.0" "42.0" | ||
| 502 | ("http://example.org") | ||
| 503 | ("a" "b") (do something)) | ||
| 504 | (mock ((guix upstream) %updaters | ||
| 505 | (delay (list (upstream-updater | ||
| 506 | (name 'dummy) | ||
| 507 | (pred (const #t)) | ||
| 508 | (description "") | ||
| 509 | (import (const (upstream-source | ||
| 510 | (package "foo") | ||
| 511 | (version "42.0") | ||
| 512 | (urls '("http://example.org"))))))))) | ||
| 513 | (let* ((old (dummy-package "foo" (version "1.0") | ||
| 514 | (source (dummy-origin | ||
| 515 | (patches '("a" "b")) | ||
| 516 | (snippet '(do something)))))) | ||
| 517 | (new (package-with-upstream-version old)) | ||
| 518 | (new+patches (package-with-upstream-version | ||
| 519 | old #:preserve-patches? #t))) | ||
| 520 | (list (package-version new) (package-version new+patches) | ||
| 521 | |||
| 522 | ;; Source of NEW is directly an <upstream-source>. | ||
| 523 | (upstream-source-urls (package-source new)) | ||
| 524 | |||
| 525 | ;; Check that #:preserve-patches? #t gave us an origin. | ||
| 526 | (origin-patches (package-source new+patches)) | ||
| 527 | (origin-snippet (package-source new+patches)))))) | ||
| 528 | |||
| 500 | (test-equal "options->transformation, with-latest" | 529 | (test-equal "options->transformation, with-latest" |
| 501 | "42.0" | 530 | "42.0" |
| 502 | (mock ((guix upstream) %updaters | 531 | (mock ((guix upstream) %updaters |
