From 82b0e27de109b38ed44f67434a96460c4a7f9217 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 9 May 2021 14:35:57 +0200
Subject: lint: tests-true: Check if tests are enabled when cross-compiling.

* guix/lint.scm (check-tests-true): New linter.
(%local-checkers)[tests-true]: Add it.
* tests/lint.scm ("tests-true: #:tests? must not be set to #t")
("tests-true: absent #:tests? is acceptable")
("tests-true: #:tests? #f is acceptable")
("tests-true: #:tests? #t acceptable when compiling natively"): Test it.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
---
 guix/lint.scm  | 26 ++++++++++++++++++++++++++
 tests/lint.scm | 23 +++++++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/guix/lint.scm b/guix/lint.scm
index 41dd5d0633..5cd6db5842 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -96,6 +97,7 @@
             check-archival
             check-profile-collisions
             check-haskell-stackage
+            check-tests-true
 
             lint-warning
             lint-warning?
@@ -191,6 +193,26 @@
                      #:field 'name)))
      (else '()))))
 
+(define (check-tests-true package)
+  "Check whether PACKAGE explicitly requests to run tests, which is
+superfluous when building natively and incorrect when cross-compiling."
+  (define (tests-explicitly-enabled?)
+    (apply (lambda* (#:key tests? #:allow-other-keys)
+             (eq? tests? #t))
+           (package-arguments package)))
+  (if (and (tests-explicitly-enabled?)
+           ;; Some packages, e.g. gnutls, set #:tests?
+           ;; differently depending on whether it is being
+           ;; cross-compiled.
+           (parameterize ((%current-target-system "aarch64-linux-gnu"))
+             (tests-explicitly-enabled?)))
+      (list (make-warning package
+                          ;; TRANSLATORS: #:tests? and #t are Scheme constants
+                          ;; and must not be translated.
+                          (G_ "#:tests? must not be explicitly set to #t")
+                          #:field 'arguments))
+      '()))
+
 (define (properly-starts-sentence? s)
   (string-match "^[(\"'`[:upper:][:digit:]]" s))
 
@@ -1524,6 +1546,10 @@ them for PACKAGE."
      (name        'name)
      (description "Validate package names")
      (check       check-name))
+   (lint-checker
+     (name        'tests-true)
+     (description "Check if tests are explicitly enabled")
+     (check       check-tests-true))
    (lint-checker
      (name        'description)
      (description "Validate package descriptions")
diff --git a/tests/lint.scm b/tests/lint.scm
index d54fafc1d2..f4c3dde774 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -277,6 +277,29 @@
    (let ((pkg (dummy-package "under_score")))
      (check-name pkg))))
 
+(test-equal "tests-true: #:tests? must not be set to #t"
+  "#:tests? must not be explicitly set to #t"
+  (single-lint-warning-message
+   (let ((pkg (dummy-package "x" (arguments '(#:tests? #t)))))
+     (check-tests-true pkg))))
+
+(test-equal "tests-true: absent #:tests? is acceptable"
+  '()
+  (let ((pkg (dummy-package "x")))
+    (check-tests-true pkg)))
+
+(test-equal "tests-true: #:tests? #f is acceptable"
+  '()
+  (let ((pkg (dummy-package "x" (arguments '(#:tests? #f)))))
+    (check-tests-true pkg)))
+
+(test-equal "tests-true: #:tests? #t acceptable when compiling natively"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (arguments
+                             `(#:tests? ,(not (%current-target-system)))))))
+    (check-tests-true pkg)))
+
 (test-equal "inputs: pkg-config is probably a native input"
   "'pkg-config' should probably be a native input"
   (single-lint-warning-message
-- 
cgit v1.2.3