diff options
author | Christopher Baines <mail@cbaines.net> | 2019-12-26 15:10:22 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-12-26 15:10:22 +0000 |
commit | c27f69ba49901fee7b6923bf07e45607fa07c587 (patch) | |
tree | b251c13ec0975624eadded3becb3c1acbecbde2c | |
parent | 450a51b3353ee9ce783de1bed90f3511f6e3102a (diff) | |
download | guix-c27f69ba49901fee7b6923bf07e45607fa07c587.tar guix-c27f69ba49901fee7b6923bf07e45607fa07c587.tar.gz |
guix: lint: Add an optional parameter for a store connection.
Previously, the derivation lint checker establishes a connection to the store
for each supported system of each package. This change uses the same store
connection for all supported systems, with the option of setting a parameter
for a store connection which will be used instead of establishing a new
connection.
Previously, running the derivation linter for all packages would take around 6
and a half minutes, with this change, without setting the
%lint-checker-store-connection parameter, the time is reduced to around 4
minutes.
* guix/lint.scm (%lint-checker-store-connection): New parameter.
(check-derivation): Arrange the code so that it's possible to either run with
the store from the new parameter, or open a new connection via the with-store
syntax.
-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." |