me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2019-01-11 15:17:10 +01:00
parent 461d6c2eff
commit 465a0d65ae
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 33 additions and 32 deletions

View File

@ -220,31 +220,32 @@ of relevance scores."
('dismiss ('dismiss
transaction) transaction)
(($ <manifest-entry> name version output (? string? path)) (($ <manifest-entry> name version output (? string? path))
(match (vhash-assoc name (find-newest-available-packages)) (match (find-best-packages-by-name name #f)
((_ candidate-version pkg . rest) ((pkg . rest)
(match (package-superseded pkg) (let ((candidate-version (package-version pkg)))
((? package? new) (match (package-superseded pkg)
(supersede entry new)) ((? package? new)
(#f (supersede entry new))
(case (version-compare candidate-version version) (#f
((>) (case (version-compare candidate-version version)
(manifest-transaction-install-entry ((>)
(package->manifest-entry* pkg output) (manifest-transaction-install-entry
transaction)) (package->manifest-entry* pkg output)
((<) transaction))
transaction) ((<)
((=) transaction)
(let ((candidate-path (derivation->output-path ((=)
(package-derivation (%store) pkg)))) (let ((candidate-path (derivation->output-path
;; XXX: When there are propagated inputs, assume we need to (package-derivation (%store) pkg))))
;; upgrade the whole entry. ;; XXX: When there are propagated inputs, assume we need to
(if (and (string=? path candidate-path) ;; upgrade the whole entry.
(null? (package-propagated-inputs pkg))) (if (and (string=? path candidate-path)
transaction (null? (package-propagated-inputs pkg)))
(manifest-transaction-install-entry transaction
(package->manifest-entry* pkg output) (manifest-transaction-install-entry
transaction)))))))) (package->manifest-entry* pkg output)
(#f transaction)))))))))
(()
(warning (G_ "package '~a' no longer exists~%") name) (warning (G_ "package '~a' no longer exists~%") name)
transaction))))) transaction)))))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -96,8 +96,8 @@
(test-assert "transaction-upgrade-entry, zero upgrades" (test-assert "transaction-upgrade-entry, zero upgrades"
(let* ((old (dummy-package "foo" (version "1"))) (let* ((old (dummy-package "foo" (version "1")))
(tx (mock ((gnu packages) find-newest-available-packages (tx (mock ((gnu packages) find-best-packages-by-name
(const vlist-null)) (const '()))
((@@ (guix scripts package) transaction-upgrade-entry) ((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))
@ -109,8 +109,8 @@
(test-assert "transaction-upgrade-entry, one upgrade" (test-assert "transaction-upgrade-entry, one upgrade"
(let* ((old (dummy-package "foo" (version "1"))) (let* ((old (dummy-package "foo" (version "1")))
(new (dummy-package "foo" (version "2"))) (new (dummy-package "foo" (version "2")))
(tx (mock ((gnu packages) find-newest-available-packages (tx (mock ((gnu packages) find-best-packages-by-name
(const (vhash-cons "foo" (list "2" new) vlist-null))) (const (list new)))
((@@ (guix scripts package) transaction-upgrade-entry) ((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))
@ -126,8 +126,8 @@
(let* ((old (dummy-package "foo" (version "1"))) (let* ((old (dummy-package "foo" (version "1")))
(new (dummy-package "bar" (version "2"))) (new (dummy-package "bar" (version "2")))
(dep (deprecated-package "foo" new)) (dep (deprecated-package "foo" new))
(tx (mock ((gnu packages) find-newest-available-packages (tx (mock ((gnu packages) find-best-packages-by-name
(const (vhash-cons "foo" (list "2" dep) vlist-null))) (const (list dep)))
((@@ (guix scripts package) transaction-upgrade-entry) ((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))