ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 06:06:53 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix package: Export 'transaction-upgrade-entry'.

Browse source 
* 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:
Ludovic Courtès 2020-01-16 10:57:19 +01:00
parent 4fe01b09ea
commit 84c5da08dd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
guix/scripts/package.scm
View file

@ -63,6 +63,8 @@ (define-module (guix scripts package)
delete-matching-generations delete-matching-generations
guix-package guix-package
transaction-upgrade-entry ;mostly for testing
(%options . %package-options) (%options . %package-options)
(%default-options . %package-default-options) (%default-options . %package-default-options)
guix-package*)) guix-package*))
@ -205,7 +207,7 @@ (define (find-packages-by-description regexps)
(package-full-name package2)) (package-full-name package2))
(> score1 score2)))))))))) (> 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 "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
<manifest-entry>." <manifest-entry>."
(define (supersede old new) (define (supersede old new)
@ -242,7 +244,7 @@ (define (supersede old new)
transaction) transaction)
((=) ((=)
(let ((candidate-path (derivation->output-path (let ((candidate-path (derivation->output-path
(package-derivation (%store) pkg)))) (package-derivation store pkg))))
;; XXX: When there are propagated inputs, assume we need to ;; XXX: When there are propagated inputs, assume we need to
;; upgrade the whole entry. ;; upgrade the whole entry.
(if (and (string=? path candidate-path) (if (and (string=? path candidate-path)
@ -600,7 +602,7 @@ (define upgrade?
(define upgraded (define upgraded
(fold (lambda (entry transaction) (fold (lambda (entry transaction)
(if (upgrade? (manifest-entry-name entry)) (if (upgrade? (manifest-entry-name entry))
(transaction-upgrade-entry entry transaction) (transaction-upgrade-entry (%store) entry transaction)
transaction)) transaction))
transaction transaction
(manifest-entries manifest))) (manifest-entries manifest)))

11
tests/packages.scm
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, 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> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -100,7 +100,8 @@ (define %store
(let* ((old (dummy-package "foo" (version "1"))) (let* ((old (dummy-package "foo" (version "1")))
(tx (mock ((gnu packages) find-best-packages-by-name (tx (mock ((gnu packages) find-best-packages-by-name
(const '())) (const '()))
((@@ (guix scripts package) transaction-upgrade-entry) (transaction-upgrade-entry
#f ;no store access needed
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/" (item (string-append (%store-prefix) "/"
@ -113,7 +114,8 @@ (define %store
(new (dummy-package "foo" (version "2"))) (new (dummy-package "foo" (version "2")))
(tx (mock ((gnu packages) find-best-packages-by-name (tx (mock ((gnu packages) find-best-packages-by-name
(const (list new))) (const (list new)))
((@@ (guix scripts package) transaction-upgrade-entry) (transaction-upgrade-entry
#f ;no store access needed
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/" (item (string-append (%store-prefix) "/"
@ -130,7 +132,8 @@ (define %store
(dep (deprecated-package "foo" new)) (dep (deprecated-package "foo" new))
(tx (mock ((gnu packages) find-best-packages-by-name (tx (mock ((gnu packages) find-best-packages-by-name
(const (list dep))) (const (list dep)))
((@@ (guix scripts package) transaction-upgrade-entry) (transaction-upgrade-entry
#f ;no store access needed
(manifest-entry (manifest-entry
(inherit (package->manifest-entry old)) (inherit (package->manifest-entry old))
(item (string-append (%store-prefix) "/" (item (string-append (%store-prefix) "/"