me
/
guix
Archived
1
0
Fork 0
Code

lint: Verify if #:tests? is respected in the 'check' phase. 

There have been a few patches to the mailing list lately
not respecting this, and this linter detects 630 package
definitions that could be modified to support the --without-tests
package transformation.

* guix/lint.scm
  (check-optional-tests): New linter.
  (%local-checkers)[optional-tests]: Add it.
* tests/lint.scm
  (package-with-phase-changes): New procedure.
  ("optional-tests: no check phase")
  ("optional-tests: check hase respects #:tests?")
  ("optional-tests: check phase ignores #:tests?")
  ("optional-tests: do not crash when #:phases is invalid")
  ("optional-tests: allow G-exps (no warning)")
  ("optional-tests: allow G-exps (warning)")
  ("optional-tests: complicated 'check' phase")
  ("optional-tests: 'check' phase is not first phase"): New tests.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
master
Maxime Devos 2021-06-28 20:44:16 +02:00 committed by Mathieu Othacehe
parent d9e0ae07db
commit 5532371a3a
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 135 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
guix/lint.scm
View File

@ -40,7 +40,8 @@
#:use-module (guix packages)
#:use-module (guix i18n)
#:use-module ((guix gexp)
#:select (local-file? local-file-absolute-file-name))
#:select (gexp? local-file? local-file-absolute-file-name
gexp->approximate-sexp))
#:use-module (guix licenses)
#:use-module (guix records)
#:use-module (guix grafts)
@ -89,6 +90,7 @@
check-source
check-source-file-name
check-source-unstable-tarball
check-optional-tests
check-mirror-url
check-github-url
check-license
@ -1098,6 +1100,58 @@ descriptions maintained upstream."
(define exception-with-kind-and-args?
(exception-predicate &exception-with-kind-and-args))
(define (check-optional-tests package)
"Emit a warning if the test suite is run unconditionally."
(define (sexp-contains-atom? sexp atom)
"Test if SEXP contains ATOM."
(if (pair? sexp)
(or (sexp-contains-atom? (car sexp) atom)
(sexp-contains-atom? (cdr sexp) atom))
(eq? sexp atom)))
(define (sexp-uses-tests?? sexp)
"Test if SEXP contains the symbol 'tests?'."
(sexp-contains-atom? sexp 'tests?))
(define (check-check-procedure expression)
(match expression
(`(,(or 'let 'let*) . ,_)
(check-check-procedure (car (last-pair expression))))
(`(,(or 'lambda 'lambda*) ,_ . ,code)
(if (sexp-uses-tests?? code)
'()
(list (make-warning package
;; TRANSLATORS: check and #:tests? are a
;; Scheme symbol and keyword respectively
;; and should not be translated.
(G_ "the 'check' phase should respect #:tests?")
#:field 'arguments))))
(_ '())))
(define (check-phases-delta delta)
(match delta
(`(replace 'check ,expression)
(check-check-procedure expression))
(_ '())))
(define (check-phases-deltas deltas)
(match deltas
(() '())
((head . tail)
(append (check-phases-delta head)
(check-phases-deltas tail)))
(_ (list (make-warning package
;; TRANSLATORS: modify-phases is a Scheme
;; syntax and must not be translated.
(G_ "incorrect call to ‘modify-phases’")
#:field 'arguments)))))
(apply (lambda* (#:key phases #:allow-other-keys)
(define phases/sexp
(if (gexp? phases)
(gexp->approximate-sexp phases)
phases))
(match phases/sexp
(`(modify-phases ,_ . ,changes)
(check-phases-deltas changes))
(_ '())))
(package-arguments package)))
(define* (check-derivation package #:key store)
"Emit a warning if we fail to compile PACKAGE to a derivation."
(define (try store system)
@ -1598,6 +1652,10 @@ them for PACKAGE."
(description "Make sure the 'license' field is a <license> \
or a list thereof")
(check check-license))
(lint-checker
(name 'optional-tests)
(description "Make sure tests are only run when requested")
(check check-optional-tests))
(lint-checker
(name 'mirror-url)
(description "Suggest 'mirror://' URLs")

77
tests/lint.scm
View File

@ -9,6 +9,7 @@
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; 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.
;;;
@ -38,7 +39,7 @@
#:use-module (guix lint)
#:use-module (guix ui)
#:use-module (guix swh)
#:use-module ((guix gexp) #:select (local-file))
#:use-module ((guix gexp) #:select (gexp local-file gexp?))
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module ((guix import hackage) #:select (%hackage-url))
#:use-module ((guix import stackage) #:select (%stackage-url))
@ -744,6 +745,80 @@
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
(define (package-with-phase-changes changes)
(dummy-package "x"
(arguments `(#:phases
,(if (gexp? changes)
#~(modify-phases %standard-phases
#$@changes)
`(modify-phases %standard-phases
,@changes))))))
(test-equal "optional-tests: no check phase"
'()
(let ((pkg (package-with-phase-changes '())))
(check-optional-tests pkg)))
(test-equal "optional-tests: check phase respects #:tests?"
'()
(let ((pkg (package-with-phase-changes
'((replace 'check
(lambda* (#:key tests? #:allow-other-keys?)
(when tests?
(invoke "./the-test-suite"))))))))
(check-optional-tests pkg)))
(test-equal "optional-tests: check phase ignores #:tests?"
"the 'check' phase should respect #:tests?"
(let ((pkg (package-with-phase-changes
'((replace 'check
(lambda _
(invoke "./the-test-suite")))))))
(single-lint-warning-message
(check-optional-tests pkg))))
(test-equal "optional-tests: do not crash when #:phases is invalid"
"incorrect call to ‘modify-phases’"
(let ((pkg (package-with-phase-changes 'this-is-not-a-list)))
(single-lint-warning-message
(check-optional-tests pkg))))
(test-equal "optional-tests: allow G-exps (no warning)"
'()
(let ((pkg (package-with-phase-changes #~())))
(check-optional-tests pkg)))
(test-equal "optional-tests: allow G-exps (warning)"
"the 'check' phase should respect #:tests?"
(let ((pkg (package-with-phase-changes
#~((replace 'check
(lambda _
(invoke "/the-test-suite")))))))
(single-lint-warning-message
(check-optional-tests pkg))))
(test-equal "optional-tests: complicated 'check' phase"
"the 'check' phase should respect #:tests?"
(let ((pkg (package-with-phase-changes
'((replace 'check
(lambda* (#:key inputs tests? #:allow-other-keys)
(let ((something (stuff from inputs or native-inputs)))
(delete-file "dateutil/test/test_utils.py")
(invoke "pytest" "-vv"))))))))
(single-lint-warning-message
(check-optional-tests pkg))))
(test-equal "optional-tests: 'check' phase is not first phase"
"the 'check' phase should respect #:tests?"
(let ((pkg (package-with-phase-changes
'((add-after 'unpack
(lambda _
(chdir "libtestcase-0.0.0")))
(replace 'check
(lambda _ (invoke "./test-suite")))))))
(single-lint-warning-message
(check-optional-tests pkg))))
(test-equal "source: 200"
'()
(with-http-server `((200 ,%long-string))