diff options
| author | Leo Prikler <leo.prikler@student.tugraz.at> | 2020-12-05 17:20:09 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-12-07 12:48:25 +0100 |
| commit | f5d952c5f50cd9c6005cdf47dda5bccb6e428119 (patch) | |
| tree | aec4d315993e20d59ff3424aa1a0b8717733a4aa | |
| parent | b3f21eb6bc895a4eafe903dfbb480de481bbb4c7 (diff) | |
| download | guix-f5d952c5f50cd9c6005cdf47dda5bccb6e428119.tar guix-f5d952c5f50cd9c6005cdf47dda5bccb6e428119.tar.gz | |
profiles: Remove duplicates in manifest transactions.
Fixes <https://bugs.gnu.org/23874>.
Reported by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.
* guix/profiles.scm (manifest-transaction-effects): Delete duplicates in
install and remove. Let multiple upgrades and downgrades shadow previous
transactions of the same kind.
* tests/profiles.scm
("manifest-transaction-effects no double install or upgrades")
("manifest-transaction-effects no double downgrade")
("manifest-transaction-effects no double removal"): New tests.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
| -rw-r--r-- | guix/profiles.scm | 18 | ||||
| -rw-r--r-- | tests/profiles.scm | 28 |
2 files changed, 44 insertions, 2 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 1b15257210..034591eb79 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -716,6 +716,12 @@ replace it." (manifest-pattern (name (manifest-entry-name entry)) (output (manifest-entry-output entry)))) + (define manifest-entry-pair=? + (match-lambda* + (((m1a . m2a) (m1b . m2b)) + (and (manifest-entry=? m1a m1b) + (manifest-entry=? m2a m2b))) + (_ #f))) (let loop ((input (manifest-transaction-install transaction)) (install '()) @@ -724,8 +730,16 @@ replace it." (match input (() (let ((remove (manifest-transaction-remove transaction))) - (values (manifest-matching-entries manifest remove) - (reverse install) (reverse upgrade) (reverse downgrade)))) + (values (delete-duplicates + (manifest-matching-entries manifest remove) + manifest-entry=?) + (delete-duplicates (reverse install) manifest-entry=?) + (delete-duplicates + (reverse upgrade) + manifest-entry-pair=?) + (delete-duplicates + (reverse downgrade) + manifest-entry-pair=?)))) ((entry rest ...) ;; Check whether installing ENTRY corresponds to the installation of a ;; new package or to an upgrade. diff --git a/tests/profiles.scm b/tests/profiles.scm index 055924ba3e..f0a1a1d11c 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -183,6 +183,16 @@ (equal? (list glibc) install) (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) +(test-assert "manifest-transaction-effects no double install or upgrades" + (let* ((m0 (manifest (list guile-1.8.8))) + (t (manifest-transaction + (install (list guile-2.0.9 glibc glibc))))) + (let-values (((remove install upgrade downgrade) + (manifest-transaction-effects m0 t))) + (and (null? remove) (null? downgrade) + (equal? (list glibc) install) + (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) + (test-assert "manifest-transaction-effects and downgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-1.8.8))))) @@ -191,6 +201,14 @@ (and (null? remove) (null? install) (null? upgrade) (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade))))) +(test-assert "manifest-transaction-effects no double downgrade" + (let* ((m0 (manifest (list guile-2.0.9))) + (t (manifest-transaction (install (list guile-1.8.8 guile-1.8.8))))) + (let-values (((remove install upgrade downgrade) + (manifest-transaction-effects m0 t))) + (and (null? remove) (null? install) (null? upgrade) + (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade))))) + (test-assert "manifest-transaction-effects and pseudo-upgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-2.0.9))))) @@ -209,6 +227,16 @@ (and (manifest-transaction-removal-candidate? guile-2.0.9 t) (not (manifest-transaction-removal-candidate? glibc t))))) +(test-assert "manifest-transaction-effects no double removal" + (let* ((m0 (manifest (list guile-2.0.9))) + (t (manifest-transaction + (remove (list (manifest-pattern (name "guile"))))))) + (let-values (((remove install upgrade downgrade) + (manifest-transaction-effects m0 t))) + (and (= 1 (length remove)) + (manifest-transaction-removal-candidate? guile-2.0.9 t) + (null? install) (null? downgrade) (null? upgrade))))) + (test-assertm "profile-derivation" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) |