mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
guix package: Export 'transaction-upgrade-entry'.
* guix/scripts/package.scm (transaction-upgrade-entry): Add 'store' parameter and use it instead of (%store). Export. * 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
4fe01b09ea
commit
84c5da08dd
2 changed files with 12 additions and 7 deletions
|
@ -63,6 +63,8 @@ (define-module (guix scripts package)
|
|||
delete-matching-generations
|
||||
guix-package
|
||||
|
||||
transaction-upgrade-entry ;mostly for testing
|
||||
|
||||
(%options . %package-options)
|
||||
(%default-options . %package-default-options)
|
||||
guix-package*))
|
||||
|
@ -205,7 +207,7 @@ (define (find-packages-by-description regexps)
|
|||
(package-full-name package2))
|
||||
(> score1 score2))))))))))
|
||||
|
||||
(define (transaction-upgrade-entry entry transaction)
|
||||
(define (transaction-upgrade-entry store entry transaction)
|
||||
"Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
|
||||
<manifest-entry>."
|
||||
(define (supersede old new)
|
||||
|
@ -242,7 +244,7 @@ (define (supersede old new)
|
|||
transaction)
|
||||
((=)
|
||||
(let ((candidate-path (derivation->output-path
|
||||
(package-derivation (%store) pkg))))
|
||||
(package-derivation store pkg))))
|
||||
;; XXX: When there are propagated inputs, assume we need to
|
||||
;; upgrade the whole entry.
|
||||
(if (and (string=? path candidate-path)
|
||||
|
@ -600,7 +602,7 @@ (define upgrade?
|
|||
(define upgraded
|
||||
(fold (lambda (entry transaction)
|
||||
(if (upgrade? (manifest-entry-name entry))
|
||||
(transaction-upgrade-entry entry transaction)
|
||||
(transaction-upgrade-entry (%store) entry transaction)
|
||||
transaction))
|
||||
transaction
|
||||
(manifest-entries manifest)))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
@ -100,7 +100,8 @@ (define %store
|
|||
(let* ((old (dummy-package "foo" (version "1")))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const '()))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(transaction-upgrade-entry
|
||||
#f ;no store access needed
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
(item (string-append (%store-prefix) "/"
|
||||
|
@ -113,7 +114,8 @@ (define %store
|
|||
(new (dummy-package "foo" (version "2")))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const (list new)))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(transaction-upgrade-entry
|
||||
#f ;no store access needed
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
(item (string-append (%store-prefix) "/"
|
||||
|
@ -130,7 +132,8 @@ (define %store
|
|||
(dep (deprecated-package "foo" new))
|
||||
(tx (mock ((gnu packages) find-best-packages-by-name
|
||||
(const (list dep)))
|
||||
((@@ (guix scripts package) transaction-upgrade-entry)
|
||||
(transaction-upgrade-entry
|
||||
#f ;no store access needed
|
||||
(manifest-entry
|
||||
(inherit (package->manifest-entry old))
|
||||
(item (string-append (%store-prefix) "/"
|
||||
|
|
Loading…
Reference in a new issue