[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: lint: Add 'check-for-collisions' checker.
From: |
guix-commits |
Subject: |
04/04: lint: Add 'check-for-collisions' checker. |
Date: |
Sun, 14 Jun 2020 09:35:12 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 993023a28e52c87647fb78a5aa94a524f42ceb71
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jun 14 15:06:53 2020 +0200
lint: Add 'check-for-collisions' checker.
Suggested by Edouard Klein <edk@beaver-labs.com>.
* guix/profiles.scm (check-for-collisions): Export.
* guix/lint.scm (check-profile-collisions): New procedure.
(%local-checkers): Add 'profile-collisions' checker.
* tests/lint.scm ("profile-collisions: no warnings")
("profile-collisions: propagated inputs collide")
("profile-collisions: propagated inputs collide, store items"): New tests.
* doc/guix.texi (Invoking guix lint): Document it.
---
doc/guix.texi | 7 +++++++
guix/lint.scm | 40 ++++++++++++++++++++++++++++++++++++++++
guix/profiles.scm | 1 +
tests/lint.scm | 30 ++++++++++++++++++++++++++++++
4 files changed, 78 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index aeeea78..333dd70 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9957,6 +9957,13 @@ autogenerated tarballs are sometimes regenerated.
Check that the derivation of the given packages can be successfully
computed for all the supported systems (@pxref{Derivations}).
+@item profile-collisions
+Check whether installing the given packages in a profile would lead to
+collisions. Collisions occur when several packages with the same name
+but a different version or a different store file name are propagated.
+@xref{package Reference, @code{propagated-inputs}}, for more information
+on propagated inputs.
+
@item archival
@cindex Software Heritage, source code archive
@cindex archival of source code, Software Heritage
diff --git a/guix/lint.scm b/guix/lint.scm
index 82861b8..fa50754 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -41,6 +41,8 @@
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (guix memoization)
+ #:use-module (guix profiles)
+ #:use-module (guix monads)
#:use-module (guix scripts)
#:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))
#:use-module (guix gnu-maintenance)
@@ -84,6 +86,7 @@
check-for-updates
check-formatting
check-archival
+ check-profile-collisions
lint-warning
lint-warning?
@@ -970,6 +973,38 @@ descriptions maintained upstream."
(with-store store
(check-with-store store))))
+(define* (check-profile-collisions package #:key store)
+ "Check for collisions that would occur when installing PACKAGE as a result
+of the propagated inputs it pulls in."
+ (define (do-check store)
+ (guard (c ((profile-collision-error? c)
+ (let ((first (profile-collision-error-entry c))
+ (second (profile-collision-error-conflict c)))
+ (define format
+ (if (string=? (manifest-entry-version first)
+ (manifest-entry-version second))
+ manifest-entry-item
+ (lambda (entry)
+ (string-append (manifest-entry-name entry) "@"
+ (manifest-entry-version entry)))))
+
+ (list (make-warning package
+ (G_ "propagated inputs ~a and ~a collide")
+ (list (format first)
+ (format second)))))))
+ ;; Disable grafts to avoid building PACKAGE and its dependencies.
+ (parameterize ((%graft? #f))
+ (run-with-store store
+ (mbegin %store-monad
+ (check-for-collisions (packages->manifest (list package))
+ (%current-system))
+ (return '()))))))
+
+ (if store
+ (do-check store)
+ (with-store store
+ (do-check store))))
+
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."
(match (package-license package)
@@ -1350,6 +1385,11 @@ or a list thereof")
(check check-derivation)
(requires-store? #t))
(lint-checker
+ (name 'profile-collisions)
+ (description "Report collisions that would occur due to propagated
inputs")
+ (check check-profile-collisions)
+ (requires-store? #t))
+ (lint-checker
(name 'patch-file-names)
(description "Validate file names and availability of patches")
(check check-patch-file-names))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 6064820..9df63c9 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -104,6 +104,7 @@
manifest-installed?
manifest-matching-entries
manifest-search-paths
+ check-for-collisions
manifest-transaction
manifest-transaction?
diff --git a/tests/lint.scm b/tests/lint.scm
index 4ce45b4..9d3c349 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -353,6 +353,36 @@
(((and (? lint-warning?) first-warning) others ...)
(lint-warning-message first-warning))))
+(test-equal "profile-collisions: no warnings"
+ '()
+ (check-profile-collisions (dummy-package "x")))
+
+(test-equal "profile-collisions: propagated inputs collide"
+ "propagated inputs p0@1 and p0@2 collide"
+ (let* ((p0 (dummy-package "p0" (version "1")))
+ (p0* (dummy-package "p0" (version "2")))
+ (p1 (dummy-package "p1" (propagated-inputs `(("p0" ,p0)))))
+ (p2 (dummy-package "p2" (propagated-inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3" (propagated-inputs `(("p0" ,p0*)))))
+ (p4 (dummy-package "p4" (propagated-inputs
+ `(("p2" ,p2) ("p3", p3))))))
+ (single-lint-warning-message
+ (check-profile-collisions p4))))
+
+(test-assert "profile-collisions: propagated inputs collide, store items"
+ (string-match-or-error
+ "propagated inputs /[[:graph:]]+-p0-1 and /[[:graph:]]+-p0-1 collide"
+ (let* ((p0 (dummy-package "p0" (version "1")))
+ (p0* (dummy-package "p0" (version "1")
+ (inputs `(("x" ,(dummy-package "x"))))))
+ (p1 (dummy-package "p1" (propagated-inputs `(("p0" ,p0)))))
+ (p2 (dummy-package "p2" (propagated-inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3" (propagated-inputs `(("p0" ,p0*)))))
+ (p4 (dummy-package "p4" (propagated-inputs
+ `(("p2" ,p2) ("p3", p3))))))
+ (single-lint-warning-message
+ (check-profile-collisions p4)))))
+
(test-equal "license: invalid license"
"invalid license field"
(single-lint-warning-message