From c4798e6154275a2de41c1d5a35bc723091d4e1a4 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Wed, 17 Mar 2021 22:56:26 +0100
Subject: [PATCH] lint: Check whether guile should be in native-inputs.

TODO less false positives (or negatives?)
TODO proper message

* guix/lint.scm
  (check-inputs-should-also-be-native): ???
  (%local-checkers)[inputs-should-also-be-native]: New ???.
---
 guix/lint.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/guix/lint.scm b/guix/lint.scm
index 311bc94cc3..d0cde23665 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,6 +76,7 @@
   #:use-module (ice-9 rdelim)
   #:export (check-description-style
             check-inputs-should-be-native
+            check-inputs-should-also-be-native
             check-inputs-should-not-be-an-input-at-all
             check-patch-file-names
             check-patch-headers
@@ -347,6 +349,36 @@ of a package, and INPUT-NAMES, a list of package specifications such as
             #:field 'inputs))
          (package-input-intersection inputs input-names))))
 
+#|
+(define (suspect-input->native-names package)
+  ;; Guile's compiled .go code is architecture
+  `(,@(if (string-prefix? "guile" (package-name package))
+         '("guile")
+         '()))
+|#
+
+(define (check-inputs-should-also-be-native package)
+  ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
+  ;; native inputs as well.
+  (guard (c ((package-cross-build-system-error? c) '()))
+    (let ((inputs (package-inputs package))
+          (native-inputs
+           ;; Pretend we're cross-compiling,
+           ;; as some packages only add the "guile" input
+           ;; to native-inputs when %current-target-system is not #f.
+           (parameterize ((%current-target-system (%current-system)))
+             (package-native-inputs package)))
+          (input-names
+           '("guile")))
+      (filter-map (lambda (input)
+                    (and (not (assoc input native-inputs))
+                         (make-warning
+                          package
+                          (G_ "'~a' should probably also be a native input")
+                          (list input)
+                          #:field 'inputs)))
+                  (package-input-intersection inputs input-names)))))
+
 (define (check-inputs-should-not-be-an-input-at-all package)
   ;; Emit a warning if some inputs of PACKAGE are likely to should not be
   ;; an input at all.
@@ -1449,6 +1481,10 @@ them for PACKAGE."
      (name        'description)
      (description "Validate package descriptions")
      (check       check-description-style))
+   (lint-checker
+     (name        'inputs-should-also-be-native)
+     (description "Identify inputs that should aso be native inputs")
+     (check        check-inputs-should-also-be-native))
    (lint-checker
      (name        'inputs-should-be-native)
      (description "Identify inputs that should be native inputs")
-- 
2.30.2