Subject: [bug#47676] [PATCH] Add 'compiler-for-target' checker

From: Maxime Devos <[email-masked]>
Date: Fri, 09 Apr 2021 17:50:35 +0200

Hi Guix,

This patch series adds a linter that detects "CC=gcc" and "CXX=g++"
in #:make-flags in the arguments field of a package.  This is incorrect
when cross-compiling; ,(string-append "CC=" (cc-for-target)) or similar
should be used instead.

Patch #1: detect "CC=gcc".
Patch #2: detect "CXX=g++".

Some complaints from the checker:
$ ./pre-inst-env guix lint -c "compiler-for-target"
> gnu/packages/admin.scm:3138:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/admin.scm:2969:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/assembly.scm:230:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/audio.scm:4870:4: [email-masked]: should use 'cc-for-target'
> gnu/packages/audio.scm:1134:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/base.scm:1290:5: tzdata@2021a: should use 'cc-for-target'
> gnu/packages/bioinformatics.scm:10977:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/bioinformatics.scm:1677:5: [email-masked]: should use 'cc-for-target'
> gnu/packages/bioinformatics.scm:4885:5: [email-masked]: should use 'cc-for-target'
> [...]

"make && make check TESTS=tests/lint.scm" succeeds.

Greetings,
Maxime.
From 223ecf6414e5fcb253ec3e27cdf6176832951270 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
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 <[email-masked]>
 ;;; Copyright © 2020 Chris Marusich <[email-masked]>
 ;;; Copyright © 2020 Timothy Sample <[email-masked]>
+;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;;
 ;;; 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: <license> 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 <[email-masked]>
 ;;; Copyright © 2018, 2019 Arun Isaac <[email-masked]>
 ;;; Copyright © 2020 Timothy Sample <[email-masked]>
+;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;;
 ;;; 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

From c28c9383afeea102f43aa40ea466bba4e32516bf Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 9 Apr 2021 17:17:01 +0200
Subject: [PATCH 2/2] lint: Extend 'compiler-for-target' to detect CXX=g++.

* guix/lint.scm (check-compiler-for-target): Detect "CXX=g++".
* tests/lint.scm
  ("compiler-for-target: no warnings (cxx-for-target)")
  ("compiler-for-target: warning (hardcoded CC=g++)"): New test cases.
---
 guix/lint.scm  | 33 +++++++++++++++++++++++----------
 tests/lint.scm | 19 ++++++++++++++++++-
 2 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/guix/lint.scm b/guix/lint.scm
index bf9acb40be..1f32ff8393 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1366,16 +1366,29 @@ host compiler."
                             ;; 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))))
+                              (evaluate-argument make-flags package))))
+                   (let ((cc (any (lambda (x)
+                                    (and (string-prefix? "CC=" x)
+                                         (substring x 3)))
+                                  make-flags/evaluated))
+                         (cxx (any (lambda (x)
+                                     (and (string-prefix? "CXX=" x)
+                                          (substring x 4)))
+                                   make-flags/evaluated)))
+                     ;; GNU's C compiler
+                     `(,@(if (and cc (string=? cc "gcc"))
+                             (list
+                              (make-warning package
+                                            (G_ "should use 'cc-for-target'")
+                                            #:field 'arguments))
+                             '())
+                       ;; GNU's C++ compiler
+                       ,@(if (and cxx (string=? cxx "g++"))
+                             (list
+                              (make-warning package
+                                            (G_ "should use 'cxx-for-target'")
+                                            #:field 'arguments))
+                             '()))))
                  '()))
            (package-arguments package))))
 
diff --git a/tests/lint.scm b/tests/lint.scm
index bda12063bc..7aa17f060a 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -40,7 +40,7 @@
   #:use-module (guix swh)
   #:use-module ((guix gexp) #:select (local-file))
   #:use-module ((guix utils) #:select (call-with-temporary-directory
-                                       cc-for-target))
+                                       cc-for-target cxx-for-target))
   #:use-module ((guix import hackage) #:select (%hackage-url))
   #:use-module ((guix import stackage) #:select (%stackage-url))
   #:use-module (gnu packages)
@@ -1117,6 +1117,14 @@
      (arguments
       `(#:make-flags (list ,(string-append "CC=" (cc-for-target))))))))
 
+(test-equal "compiler-for-target: no warnings (cxx-for-target)"
+  '()
+  (check-compiler-for-target
+   (package
+     (inherit (dummy-package "x"))
+     (arguments
+      `(#:make-flags (list ,(string-append "CXX=" (cxx-for-target))))))))
+
 (test-equal "compiler-for-target: warning (hardcoded CC=gcc)"
   "should use 'cc-for-target'"
   (single-lint-warning-message
@@ -1126,6 +1134,15 @@
       (arguments
        `(#:make-flags '("CC=gcc")))))))
 
+(test-equal "compiler-for-target: warning (hardcoded CC=g++)"
+  "should use 'cxx-for-target'"
+  (single-lint-warning-message
+   (check-compiler-for-target
+    (package
+      (inherit (dummy-package "x"))
+      (arguments
+       `(#:make-flags '("CXX=g++")))))))
+
 (test-end "lint")
 
 ;; Local Variables:
-- 
2.31.1