ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix package: Do not misdiagnose upgrades when there are propagated inputs.

Browse source 
Fixes <https://bugs.gnu.org/35872>.
Reported by Andy Tai <atai@atai.org>.

* guix/profiles.scm (list=?, manifest-entry=?): New procedures.
* guix/scripts/package.scm (transaction-upgrade-entry): In the '=' case,
use 'manifest-entry=?' to determine whether it's an upgrade.
* tests/packages.scm ("transaction-upgrade-entry, zero upgrades,
propagated inputs"): New test.
This commit is contained in:
Ludovic Courtès 2020-03-30 23:34:48 +02:00
parent b9c79cae53
commit a357849f5b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 54 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
guix/profiles.scm
View file

@ -89,6 +89,8 @@ (define-module (guix profiles)
manifest-entry-properties
lower-manifest-entry
manifest-entry=?
manifest-pattern
manifest-pattern?
manifest-pattern-name
@ -217,6 +219,33 @@ (define-record-type* <manifest-pattern> manifest-pattern
(output manifest-pattern-output ; string | #f
(default "out")))
(define (list=? = lst1 lst2)
"Return true if LST1 and LST2 have the same length and their elements are
pairwise equal per =."
(match lst1
(()
(null? lst2))
((head1 . tail1)
(match lst2
((head2 . tail2)
(and (= head1 head2) (list=? = tail1 tail2)))
(()
#f)))))
(define (manifest-entry=? entry1 entry2)
"Return true if ENTRY1 is equivalent to ENTRY2, ignoring their 'properties'
field."
(match entry1
(($ <manifest-entry> name1 version1 output1 item1 dependencies1 paths1)
(match entry2
(($ <manifest-entry> name2 version2 output2 item2 dependencies2 paths2)
(and (string=? name1 name2)
(string=? version1 version2)
(string=? output1 output2)
(equal? item1 item2) ;XXX: could be <package> vs. store item
(equal? paths1 paths2)
(list=? manifest-entry=? dependencies1 dependencies2)))))))
(define (manifest-transitive-entries manifest)
"Return the entries of MANIFEST along with their propagated inputs,
recursively."

11
guix/scripts/package.scm
View file

@ -240,14 +240,9 @@ (define (upgrade entry)
;; displaying the list of packages to install/upgrade
;; upfront. Thus, if lowering NEW triggers a build (due
;; to grafts), assume NEW differs from ENTRY.
;; XXX: When there are propagated inputs, assume we need to
;; upgrade the whole entry.
(if (and (with-build-handler (const #f)
(string=? (manifest-entry-item
(lower-manifest-entry* new))
(manifest-entry-item entry)))
(null? (package-propagated-inputs pkg)))
(if (with-build-handler (const #f)
(manifest-entry=? (lower-manifest-entry* new)
entry))
transaction
(manifest-transaction-install-entry
new transaction)))))))))

22
tests/packages.scm
View file

@ -122,6 +122,28 @@ (define %store
(manifest-transaction)))))
(manifest-transaction-null? tx)))
(test-assert "transaction-upgrade-entry, zero upgrades, propagated inputs"
;; Properly detect equivalent packages even when they have propagated
;; inputs. See <https://bugs.gnu.org/35872>.
(let* ((dep (dummy-package "dep" (version "2")))
(old (dummy-package "foo" (version "1")
(propagated-inputs `(("dep" ,dep)))))
(drv (package-derivation %store old))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list old)))
(transaction-upgrade-entry
%store
(manifest-entry
(inherit (package->manifest-entry old))
(item (derivation->output-path drv))
(dependencies
(list (manifest-entry
(inherit (package->manifest-entry dep))
(item (derivation->output-path
(package-derivation %store dep)))))))
(manifest-transaction)))))
(manifest-transaction-null? tx)))
(test-assert "transaction-upgrade-entry, one upgrade"
(let* ((old (dummy-package "foo" (version "1")))
(new (dummy-package "foo" (version "2")))