diff options
Diffstat (limited to 'guix/lint.scm')
| -rw-r--r-- | guix/lint.scm | 139 |
1 files changed, 81 insertions, 58 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 8e3976171f..f692856f42 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -52,6 +52,7 @@ #:use-module (guix memoization) #:use-module (guix profiles) #:use-module (guix monads) + #:use-module (guix platform) #:use-module (guix scripts) #:use-module ((guix ui) #:select (texi->plain-text fill-paragraph)) #:use-module (guix gnu-maintenance) @@ -98,7 +99,6 @@ check-patch-file-names check-patch-headers check-synopsis-style - check-derivation check-home-page check-name check-source @@ -116,6 +116,8 @@ check-haskell-stackage check-tests-true + make-check-derivation-for-system + lint-warning lint-warning? lint-warning-package @@ -1369,56 +1371,6 @@ password, provided REF's URI is HTTP or HTTPS." (append-map check-phases-delta deltas)) (find-phase-deltas package check-phases-deltas)) -(define* (check-derivation package #:key store) - "Emit a warning if we fail to compile PACKAGE to a derivation." - (define (try store system) - (guard (c ((store-protocol-error? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (store-protocol-error-message c)))) - ((exception-with-kind-and-args? c) - (make-warning package - (G_ "failed to create ~a derivation: ~s") - (list system - (cons (exception-kind c) - (exception-args c))))) - ((message-condition? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (condition-message c)))) - ((formatted-message? c) - (let ((str (apply format #f - (formatted-message-string c) - (formatted-message-arguments c)))) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system str)))) - (else - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system c)))) - (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)))))) - - (define (check-with-store store) - (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-profile-collisions package #:key store) "Check for collisions that would occur when installing PACKAGE as a result of the propagated inputs it pulls in." @@ -1843,13 +1795,88 @@ them for PACKAGE." (G_ "source file not found")))))))) '()))) +(define (make-check-derivation-for-system system) + (define (try package proc) + (guard (c ((store-protocol-error? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (store-protocol-error-message c)))) + ((exception-with-kind-and-args? c) + (make-warning package + (G_ "failed to create ~a derivation: ~s") + (list system + (cons (exception-kind c) + (exception-args c))))) + ((message-condition? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (condition-message c)))) + ((formatted-message? c) + (let ((str (apply format #f + (formatted-message-string c) + (formatted-message-arguments c)))) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system str)))) + (else + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system c)))) + (proc))) + + + + (lambda* (package #:key store) + "Emit a warning if we fail to compile PACKAGE to a derivation." + + (define (check-with-store store) + (if (member system (package-supported-systems package)) + (filter + lint-warning? + (map (cut try package <>) + (list + (lambda () + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f))) + (lambda () + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (parameterize ((%graft? #f)) + (package-derivation store replacement system + #:graft? #f)))))))) + '())) + + ;; For backwards compatability, don't rely on store being set + (or (and=> store check-with-store) + (with-store store + (check-with-store store))))) + ;;; ;;; List of checkers. ;;; +(define %derivation-checkers + (map (lambda (system) + (lint-checker + (name (string->symbol + (simple-format #f "derivation/~A" system))) + (description + (simple-format + #f + "Report failure to compile a package to a derivation for ~A" + system)) + (check (make-check-derivation-for-system system)) + (requires-store? #t))) + (systems))) + (define %local-checkers - (list + (cons* (lint-checker (name 'name) (description "Validate package names") @@ -1902,11 +1929,6 @@ or a list thereof") (description "Check for autogenerated tarballs") (check check-source-unstable-tarball)) (lint-checker - (name 'derivation) - (description "Report failure to compile a package to a derivation") - (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) @@ -1922,7 +1944,8 @@ or a list thereof") (lint-checker (name 'formatting) (description "Look for formatting issues in the source") - (check check-formatting)))) + (check check-formatting)) + %derivation-checkers)) (define %network-dependent-checkers (list |