me
/
guix
Archived
1
0
Fork 0
Code

lint: Add a #:store argument to check-derivation 

This can then be used to avoid opening up a store connection each time a
package needs checking.

* guix/lint.scm (check-derivation): Add a #:store argument, and pull the
handling of the store connection out of the try function.
master
Christopher Baines 2020-03-15 20:53:02 +00:00
parent d84ad6a24e
commit 7826fbc02b
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
guix/lint.scm
View File

@ -918,9 +918,9 @@ descriptions maintained upstream."
(define exception-with-kind-and-args? (define exception-with-kind-and-args?
(const #f)))) (const #f))))
(define (check-derivation package) (define* (check-derivation package #:key store)
"Emit a warning if we fail to compile PACKAGE to a derivation." "Emit a warning if we fail to compile PACKAGE to a derivation."
(define (try system) (define (try store system)
(catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported. (catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported.
(lambda () (lambda ()
(guard (c ((store-protocol-error? c) (guard (c ((store-protocol-error? c)
@ -939,25 +939,29 @@ descriptions maintained upstream."
(G_ "failed to create ~a derivation: ~a") (G_ "failed to create ~a derivation: ~a")
(list system (list system
(condition-message c))))) (condition-message c)))))
(with-store store (parameterize ((%graft? #f))
;; Disable grafts since it can entail rebuilds. (package-derivation store package system #:graft? #f)
(parameterize ((%graft? #f))
(package-derivation store package system #:graft? #f)
;; If there's a replacement, make sure we can compute its ;; If there's a replacement, make sure we can compute its
;; derivation. ;; derivation.
(match (package-replacement package) (match (package-replacement package)
(#f #t) (#f #t)
(replacement (replacement
(package-derivation store replacement system (package-derivation store replacement system
#:graft? #f))))))) #:graft? #f))))))
(lambda args (lambda args
(make-warning package (make-warning package
(G_ "failed to create ~a derivation: ~s") (G_ "failed to create ~a derivation: ~s")
(list system args))))) (list system args)))))
(filter lint-warning? (define (check-with-store store)
(map try (package-supported-systems package)))) (filter lint-warning?
(map (cut try store <>) (package-supported-systems package))))
;; For backwards compatability, don't rely on store being set
(or (and=> store check-with-store)
(with-store store
(check-with-store store))))
(define (check-license package) (define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE." "Warn about type errors of the 'license' field of PACKAGE."