amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: lint: Check for misplaced argument flags.

Browse source 
* 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
This commit is contained in:
Efraim Flashner 2025-07-09 09:58:46 +03:00
parent fb8574b148
commit 54717bb5b3
No known key found for this signature in database
GPG key ID: 41AAE7DCCA3D8351
3 changed files with 128 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

62
guix/lint.scm
View file

@ -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)
@ -2079,6 +2137,10 @@ or a list thereof")
(name 'source-unstable-tarball)
(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")