From 223ecf6414e5fcb253ec3e27cdf6176832951270 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Fri, 9 Apr 2021 16:34:27 +0200 Subject: [PATCH 1/2] lint: Add 'compiler-for-target' checker. This new checker detects #:make-flags '("CC=gcc"), which is incorrect when cross-compiling, and suggests using 'cc-for-target' instead for discovering which compiler to use. * guix/lint.scm (sandbox): New variable. (evaluate-argument, check-compiler-for-target): New procedures. (%local-checkers): Add 'compiler-for-target' checker. * tests/lint.scm ("compiler-for-target: no warnings") ("compiler-for-target: no warnings (cc-for-target)") ("compiler-for-target: warning (hardcoded CC=gcc)"): New test cases. --- guix/lint.scm | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/lint.scm | 25 ++++++++++++++++- 2 files changed, 99 insertions(+), 1 deletion(-) diff --git a/guix/lint.scm b/guix/lint.scm index be524b2b56..bf9acb40be 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2018, 2019 Arun Isaac ;;; Copyright © 2020 Chris Marusich ;;; Copyright © 2020 Timothy Sample +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,9 +64,15 @@ #:select (maybe-expand-mirrors (open-connection-for-uri . guix:open-connection-for-uri))) + #:autoload (guix build-system) (build-system-lower + bag-outputs + bag-target-inputs + bag-host-inputs + bag-build-inputs) #:use-module (web request) #:use-module (web response) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-6) ;Unicode string ports #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) @@ -73,6 +80,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 rdelim) + #:autoload (ice-9 sandbox) (make-sandbox-module all-pure-bindings) #:export (check-description-style check-inputs-should-be-native check-inputs-should-not-be-an-input-at-all @@ -93,6 +101,7 @@ check-archival check-profile-collisions check-haskell-stackage + check-compiler-for-target lint-warning lint-warning? @@ -1308,6 +1317,68 @@ Stackage LTS version." '())) (#f '()))) +(define sandbox (delay (make-sandbox-module all-pure-bindings))) + +(define (evaluate-argument exp package) + "Evaluate EXP in a sandbox emulating the build environment of PACKAGE. +The emulation is imperfect, e.g. the I/O procedures are missing. As such, +it is recommended to call this procedure from a 'false-if-exception' form +or similar." + (define (fabricate-inputs prefix inputs) + (map (lambda (input) + (cons (car input) (string-append prefix (car input)))) + inputs)) + ;; Use the bag instead of the package to automatically + ;; add the implicit inputs. + (let* ((bag (package->bag package #:graft? #f)) + ;; Fabricate %outputs, %output and %build-inputs and others, + ;; as these are sometimes referred to from the expression after + ;; #:make-flags. + (exp* `(let* ((%outputs + ',(map (lambda (output) + (cons output + (string-append "/output/" output))) + (bag-outputs bag))) + (%output "/output/out") + (%build-target-inputs + ',(fabricate-inputs "/target-inputs/" + (bag-target-inputs bag))) + (%build-host-inputs + ',(fabricate-inputs "/host-inputs/" + (bag-host-inputs bag))) + (%build-inputs + ',(fabricate-inputs "/build-inputs/" + (bag-build-inputs bag))) + (getenv (lambda (_) "/somewhere")) + (getcwd (lambda () "/nowhere"))) + ,exp))) + (eval exp* (force sandbox)))) + +(define (check-compiler-for-target package) + "Check whether PACKAGE uses the cross-compiler instead of the +host compiler." + ;; Pretend we are cross-compiling. + (parameterize ((%current-target-system (%current-system))) + (apply (lambda* (#:key make-flags #:allow-other-keys) + (or (and-let* ((make-flags make-flags) + ;; Not all build systems support cross + ;; builds and try-evaluate does not + ;; support all patterns. + (make-flags/evaluated + (false-if-exception + (evaluate-argument make-flags package))) + (cc (any (lambda (x) + (and (string-prefix? "CC=" x) + (substring x 3))) + make-flags/evaluated))) + (and cc (string=? cc "gcc") + (list + (make-warning package + (G_ "should use 'cc-for-target'") + #:field 'arguments)))) + '())) + (package-arguments package)))) + ;;; ;;; Source code formatting. @@ -1458,6 +1529,10 @@ them for PACKAGE." (name 'inputs-should-not-be-input) (description "Identify inputs that shouldn't be inputs at all") (check check-inputs-should-not-be-an-input-at-all)) + (lint-checker + (name 'compiler-for-target) + (description "Verify the cross-compiler is used") + (check check-compiler-for-target)) (lint-checker (name 'license) ;; TRANSLATORS: is the name of a data type and must not be diff --git a/tests/lint.scm b/tests/lint.scm index bd8604f589..bda12063bc 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Efraim Flashner ;;; Copyright © 2018, 2019 Arun Isaac ;;; Copyright © 2020 Timothy Sample +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,7 +39,8 @@ #:use-module (guix ui) #:use-module (guix swh) #:use-module ((guix gexp) #:select (local-file)) - #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module ((guix utils) #:select (call-with-temporary-directory + cc-for-target)) #:use-module ((guix import hackage) #:select (%hackage-url)) #:use-module ((guix import stackage) #:select (%stackage-url)) #:use-module (gnu packages) @@ -1103,6 +1105,27 @@ (string-contains (lint-warning-message warning) "ahead of Stackage LTS version")))))) +(test-equal "compiler-for-target: no warnings" + '() + (check-profile-collisions (dummy-package "x"))) + +(test-equal "compiler-for-target: no warnings (cc-for-target)" + '() + (check-compiler-for-target + (package + (inherit (dummy-package "x")) + (arguments + `(#:make-flags (list ,(string-append "CC=" (cc-for-target)))))))) + +(test-equal "compiler-for-target: warning (hardcoded CC=gcc)" + "should use 'cc-for-target'" + (single-lint-warning-message + (check-compiler-for-target + (package + (inherit (dummy-package "x")) + (arguments + `(#:make-flags '("CC=gcc"))))))) + (test-end "lint") ;; Local Variables: -- 2.31.1