diff options
-rw-r--r-- | guix/lint.scm | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index cd2ea571ed..19498db857 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -100,7 +100,9 @@ lint-checker? lint-checker-name lint-checker-description - lint-checker-check)) + lint-checker-check + + %lint-checker-store-connection)) ;;; @@ -142,6 +144,9 @@ ((_ package (G_ message) rest ...) (%make-warning package message rest ...)))) +(define %lint-checker-store-connection + (make-parameter #f)) + ;;; ;;; Checkers @@ -887,7 +892,7 @@ descriptions maintained upstream." (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." - (define (try system) + (define (try store system) (catch #t (lambda () (guard (c ((store-protocol-error? c) @@ -900,25 +905,30 @@ descriptions maintained upstream." (G_ "failed to create ~a derivation: ~a") (list system (condition-message c))))) - (with-store store - ;; Disable grafts since it can entail rebuilds. - (parameterize ((%graft? #f)) - (package-derivation store package system #:graft? #f) - - ;; If there's a replacement, make sure we can compute its - ;; derivation. - (match (package-replacement package) - (#f #t) - (replacement - (package-derivation store replacement system - #:graft? #f))))))) + ;; Disable grafts since it can entail rebuilds. + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f) + + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (package-derivation store replacement system + #:graft? #f)))))) (lambda args (make-warning package (G_ "failed to create ~a derivation: ~s") (list system args))))) - (filter lint-warning? - (map try (package-supported-systems package)))) + (define (check-with-store store) + (filter lint-warning? + (map (cut try store <>) (package-supported-systems package)))) + + (or (and=> (%lint-checker-store-connection) + check-with-store) + (with-store store + (check-with-store store)))) (define (check-license package) "Warn about type errors of the 'license' field of PACKAGE." |