mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
guix package: Avoid 'find-newest-available-packages'.
* guix/scripts/package.scm (transaction-upgrade-entry): Use 'find-best-packages-by-name' instead of 'find-newest-available-packages'. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades") ("transaction-upgrade-entry, one upgrade") ("transaction-upgrade-entry, superseded package"): Adjust accordingly.
This commit is contained in:
parent
461d6c2eff
commit
465a0d65ae
2 changed files with 33 additions and 32 deletions
|
@ -220,31 +220,32 @@ (define (supersede old new)
|
|||
('dismiss
|
||||
transaction)
|
||||
(($ <manifest-entry> name version output (? string? path))
|
||||
(match (vhash-assoc name (find-newest-available-packages))
|
||||
((_ candidate-version pkg . rest)
|
||||
(match (package-superseded pkg)
|
||||
((? package? new)
|
||||
(supersede entry new))
|
||||
(#f
|
||||
(case (version-compare candidate-version version)
|
||||
((>)
|
||||
(manifest-transaction-install-entry
|
||||
(package->manifest-entry* pkg output)
|
||||
transaction))
|
||||
((<)
|
||||
transaction)
|
||||
((=)
|
||||
(let ((candidate-path (derivation->output-path
|
||||
(package-derivation (%store) pkg))))
|
||||
;; XXX: When there are propagated inputs, assume we need to
|
||||
;; upgrade the whole entry.
|
||||
(if (and (string=? path candidate-path)
|
||||
(null? (package-propagated-inputs pkg)))
|
||||
transaction
|
||||
(manifest-transaction-install-entry
|
||||
(package->manifest-entry* pkg output)
|
||||
transaction))))))))
|
||||
(#f
|
||||
(match (find-best-packages-by-name name #f)
|
||||
((pkg . rest)
|
||||
(let ((candidate-version (package-version pkg)))
|
||||
(match (package-superseded pkg)
|
||||
((? package? new)
|
||||
(supersede entry new))
|
||||
(#f
|
||||
(case (version-compare candidate-version version)
|
||||
((>)
|
||||
(manifest-transaction-install-entry
|
||||
(package->manifest-entry* pkg output)
|
||||
transaction))
|
||||
((<)
|
||||
transaction)
|
||||
((=)
|
||||
(let ((candidate-path (derivation->output-path
|
||||
(package-derivation (%store) pkg))))
|
||||
;; XXX: When there are propagated inputs, assume we need to
|
||||
;; upgrade the whole entry.
|
||||
(if (and (string=? path candidate-path)
|
||||
(null? (package-propagated-inputs pkg)))
|
||||
transaction
|
||||
(manifest-transaction-install-entry
|
||||
(package->manifest-entry* pkg output)
|
||||
transaction)))))))))
|
||||
(()
|
||||
(warning (G_ "package '~a' no longer exists~%") name)
|
||||
transaction)))))
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -96,8 +96,8 @@ (define %store
|
|||
|
||||
(test-assert "transaction-upgrade-entry, zero upgrades"
|
||||
(let* ((old (dummy-package "foo" (version "1")))
|
||||
(tx (mock ((gnu packages) find-newest-available-packages
|
||||
(const vlist-null))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const '()))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
|
@ -109,8 +109,8 @@ (define %store
|
|||
(test-assert "transaction-upgrade-entry, one upgrade"
|
||||
(let* ((old (dummy-package "foo" (version "1")))
|
||||
(new (dummy-package "foo" (version "2")))
|
||||
(tx (mock ((gnu packages) find-newest-available-packages
|
||||
(const (vhash-cons "foo" (list "2" new) vlist-null)))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const (list new)))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
|
@ -126,8 +126,8 @@ (define %store
|
|||
(let* ((old (dummy-package "foo" (version "1")))
|
||||
(new (dummy-package "bar" (version "2")))
|
||||
(dep (deprecated-package "foo" new))
|
||||
(tx (mock ((gnu packages) find-newest-available-packages
|
||||
(const (vhash-cons "foo" (list "2" dep) vlist-null)))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const (list dep)))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
|
|
Loading…
Reference in a new issue