3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

lint: 'check-derivation' tries all the package's supported systems.

This allows us to catch architecture-specific evaluation failures.

* guix/scripts/lint.scm (check-derivation): Move body into...
[try]: ... this.  New procedure.
Call 'try' for each supported system of PACKAGE.
This commit is contained in:
Ludovic Courtès 2018-11-20 18:25:13 +01:00
parent 242b29baa1
commit 3b32891b12
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 25 deletions

View file

@ -774,30 +774,36 @@ descriptions maintained upstream."
(define (check-derivation package) (define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation." "Emit a warning if we fail to compile PACKAGE to a derivation."
(catch #t (define (try system)
(lambda () (catch #t
(guard (c ((nix-protocol-error? c) (lambda ()
(emit-warning package (guard (c ((nix-protocol-error? c)
(format #f (G_ "failed to create derivation: ~a") (emit-warning package
(nix-protocol-error-message c)))) (format #f (G_ "failed to create ~a derivation: ~a")
((message-condition? c) system
(emit-warning package (nix-protocol-error-message c))))
(format #f (G_ "failed to create derivation: ~a") ((message-condition? c)
(condition-message c))))) (emit-warning package
(with-store store (format #f (G_ "failed to create ~a derivation: ~a")
;; Disable grafts since it can entail rebuilds. system
(package-derivation store package #:graft? #f) (condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(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 #:graft? #f)))))) (package-derivation store replacement system
(lambda args #:graft? #f))))))
(emit-warning package (lambda args
(format #f (G_ "failed to create derivation: ~s~%") (emit-warning package
args))))) (format #f (G_ "failed to create ~a derivation: ~s")
system args)))))
(for-each try (package-supported-systems package)))
(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."

View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@ -365,7 +365,7 @@
(arguments (arguments
'(#:imported-modules (invalid-module)))))) '(#:imported-modules (invalid-module))))))
(check-derivation pkg))) (check-derivation pkg)))
"failed to create derivation"))) "failed to create")))
(test-assert "license: invalid license" (test-assert "license: invalid license"
(string-contains (string-contains