guix: lint: Check for misplaced argument flags.

* guix/lint.scm (check-misplaced-flags): New procedure.
(%local-checkers): Register new lint-checker.
* doc/guix.texi (Invoking guix lint): Add entry for misplaced-flags.
* tests/lint.scm (misplaced-flags: make-flag is incorrect,
misplaced-flags: configure-flag is incorrect, misplaced-flags: cargo
feature flags, misplaced-flags: flags without g-exp is incorrect,
misplaced-flags: build-type set correctly): New tests.

Change-Id: Ia8abbe787e26bffc65ee5c763326c7e271c189a4

1 files changed, 62 insertions, 0 deletions

diff --git a/guix/lint.scm b/guix/lint.scm
index aae10fe492..f09fb24347 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -117,6 +117,7 @@
             check-vulnerabilities
             check-for-updates
             check-formatting
+            check-misplaced-flags
             check-archival
             check-profile-collisions
             check-haskell-stackage
@@ -1635,6 +1636,63 @@ vulnerability records for PACKAGE by calling PACKAGE-VULNERABILITIES."
                (list (string-join (map vulnerability-id unpatched)
                                   ", "))))))))))
 
+(define (check-misplaced-flags package)
+  "Check if there are flags set (for example, in #:configure-flags) which
+can be set as part of the build system."
+  (define (make-misplaced-flag-warning flag)
+    (define (flag-pair flag)
+      (cond ((string-prefix? "-DCMAKE_BUILD_TYPE" flag)
+             '("CMAKE_BUILD_TYPE" "build-type"))
+            ((string-prefix? "--buildtype" flag)
+             '("buildtype" "build-type"))
+            ((or (string-prefix? "-Drelease-" flag)
+                 (string-prefix? "--release" flag))
+             '("release" "release-type"))
+            ((string-prefix? "--features" flag)
+             '("features" "features"))))
+    (list (make-warning package
+                  (G_ "'~a' should be set with the '~a' flag")
+                  (flag-pair flag)
+                  #:field 'arguments)))
+  (define (find-incorrect-flags flag)
+    (match flag
+      ((and (? (cut string? <>))
+            (or (? (cut string-prefix? "-DCMAKE_BUILD_TYPE=" <>))
+                (? (cut string-prefix? "--buildtype=" <>))
+                (? (cut string-prefix? "-Drelease-" <>))
+                (? (cut string-prefix? "--release=" <>))
+                (? (cut string-prefix? "--features" <>))))
+       (make-misplaced-flag-warning flag))
+      ((x . y)
+       (append (find-incorrect-flags x)
+               (find-incorrect-flags y)))
+      (_ '())))
+  (apply (lambda* (#:key (make-flags '()) (configure-flags '())
+                   (cargo-build-flags '())
+                   (cargo-test-flags '())
+                   #:allow-other-keys)
+           (define make-flags/sexp
+             (if (gexp? make-flags)
+                 (gexp->approximate-sexp make-flags)
+                 make-flags))
+           (define configure-flags/sexp
+             (if (gexp? configure-flags)
+                 (gexp->approximate-sexp configure-flags)
+                 configure-flags))
+           (define cargo-build-flags/sexp
+             (if (gexp? cargo-build-flags)
+                 (gexp->approximate-sexp cargo-build-flags)
+                 cargo-build-flags))
+           (define cargo-test-flags/sexp
+             (if (gexp? cargo-test-flags)
+                 (gexp->approximate-sexp cargo-test-flags)
+                 cargo-test-flags))
+           (find-incorrect-flags (append make-flags/sexp
+                                         configure-flags/sexp
+                                         cargo-build-flags/sexp
+                                         cargo-test-flags/sexp)))
+         (package-arguments package)))
+
 (define (check-for-updates package)
   "Check if there is an update available for PACKAGE."
   (match (lookup-updater package)
@@ -2080,6 +2138,10 @@ or a list thereof")
      (description "Check for autogenerated tarballs")
      (check       check-source-unstable-tarball))
    (lint-checker
+     (name        'misplaced-flags)
+     (description "Check for misplaced flags")
+     (check       check-misplaced-flags))
+   (lint-checker
      (name            'derivation)
      (description     "Report failure to compile a package to a derivation")
      (check           check-derivation)