lint: Add 'formatting' checker.

* guix/scripts/lint.scm (report-tabulations, report-trailing-white-space,
  report-long-line, report-formatting-issues, check-formatting): New
  procedures.
  (%formatting-reporters): New variable.
  (%checkers): Add 'formatting' checker.
* tests/lint.scm ("formatting: tabulation", "formatting: trailing white
  space", "formatting: long line", "formatting: alright"): New tests.
* doc/guix.texi (Invoking guix lint): Mention the 'formatting' checker.
This commit is contained in:
Ludovic Courtès 2015-08-19 11:22:07 +02:00
parent 7cb6f648b2
commit 40a7d4e58b
3 changed files with 111 additions and 2 deletions

View File

@ -4117,6 +4117,10 @@ Identify inputs that should most likely be native inputs.
@itemx home-page @itemx home-page
Probe @code{home-page} and @code{source} URLs and report those that are Probe @code{home-page} and @code{source} URLs and report those that are
invalid. invalid.
@item formatting
Warn about obvious source code formatting issues: trailing white space,
use of tabulations, etc.
@end table @end table
The general syntax is: The general syntax is:

View File

@ -47,6 +47,7 @@
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (ice-9 rdelim)
#:export (guix-lint #:export (guix-lint
check-description-style check-description-style
check-inputs-should-be-native check-inputs-should-be-native
@ -54,7 +55,8 @@
check-synopsis-style check-synopsis-style
check-derivation check-derivation
check-home-page check-home-page
check-source)) check-source
check-formatting))
;;; ;;;
@ -509,6 +511,79 @@ descriptions maintained upstream."
(format #f (_ "failed to create derivation: ~s~%") (format #f (_ "failed to create derivation: ~s~%")
args))))) args)))))
;;;
;;; Source code formatting.
;;;
(define (report-tabulations package line line-number)
"Warn about tabulations found in LINE."
(match (string-index line #\tab)
(#f #t)
(index
(emit-warning package
(format #f (_ "tabulation on line ~a, column ~a")
line-number index)))))
(define (report-trailing-white-space package line line-number)
"Warn about trailing white space in LINE."
(unless (or (string=? line (string-trim-right line))
(string=? line (string #\page)))
(emit-warning package
(format #f
(_ "trailing white space on line ~a")
line-number))))
(define (report-long-line package line line-number)
"Emit a warning if LINE is too long."
;; Note: We don't warn at 80 characters because sometimes hashes and URLs
;; make it hard to fit within that limit and we want to avoid making too
;; much noise.
(when (> (string-length line) 90)
(emit-warning package
(format #f (_ "line ~a is way too long (~a characters)")
line-number (string-length line)))))
(define %formatting-reporters
;; List of procedures that report formatting issues. These are not separate
;; checkers because they would need to re-read the file.
(list report-tabulations
report-trailing-white-space
report-long-line))
(define* (report-formatting-issues package file starting-line
#:key (reporters %formatting-reporters))
"Report white-space issues in FILE starting from STARTING-LINE, and report
them for PACKAGE."
(define last-line
;; Number of the presumed last line.
;; XXX: Ideally we'd stop at the boundaries of the surrounding sexp, but
;; for now just use this simple heuristic.
(+ starting-line 60))
(call-with-input-file file
(lambda (port)
(let loop ((line-number 1))
(let ((line (read-line port)))
(or (eof-object? line)
(> line-number last-line)
(begin
(unless (< line-number starting-line)
(for-each (lambda (report)
(report package line line-number))
reporters))
(loop (+ 1 line-number)))))))))
(define (check-formatting package)
"Check the formatting of the source code of PACKAGE."
(let ((location (package-location package)))
(when location
(and=> (search-path %load-path (location-file location))
(lambda (file)
;; Report issues starting from the line before the 'package'
;; form, which usually contains the 'define' form.
(report-formatting-issues package file
(- (location-line location) 1)))))))
;;; ;;;
@ -548,7 +623,11 @@ descriptions maintained upstream."
(lint-checker (lint-checker
(name 'synopsis) (name 'synopsis)
(description "Validate package synopses") (description "Validate package synopses")
(check check-synopsis-style)))) (check check-synopsis-style))
(lint-checker
(name 'formatting)
(description "Look for formatting issues in the source")
(check check-formatting))))
(define (run-checkers package checkers) (define (run-checkers package checkers)
;; Run the given CHECKERS on PACKAGE. ;; Run the given CHECKERS on PACKAGE.

View File

@ -420,6 +420,32 @@ requests."
(check-source pkg)))) (check-source pkg))))
"not reachable: 404"))) "not reachable: 404")))
(test-assert "formatting: tabulation"
(string-contains
(with-warnings
(check-formatting (dummy-package "leave the tab here: ")))
"tabulation"))
(test-assert "formatting: trailing white space"
(string-contains
(with-warnings
;; Leave the trailing white space on the next line!
(check-formatting (dummy-package "x")))
"trailing white space"))
(test-assert "formatting: long line"
(string-contains
(with-warnings
(check-formatting
(dummy-package "x" ;here is a stupid comment just to make a long line
)))
"too long"))
(test-assert "formatting: alright"
(string-null?
(with-warnings
(check-formatting (dummy-package "x")))))
(test-end "lint") (test-end "lint")