Add checkpatch.scm script and require maintainers to run it.
The goal of this script is similar to Linux's checkpatch.pl: it is
meant to check patch before sending them.
Right now it only tests if a signed-off-by is missing, and if the
commit information (commit message, author, date, etc but not the
diff) is too big as a workaround to the bug #66268[1], but over time
more checks can be added.
The report of the bug #66268[1] mention that what tend to trigger the
issue is commits "with a large (4kB) commit message".
[1]https://debbugs.gnu.org/cgi/bugreport.cgi?bug=66268
So we want to avoid such commits to avoid breaking "guix git
authenticate" in the future.
To do that, checkpatch.scm reports an error if the size of the patch
from the beginning of the patch file until the point where the diff
starts is less than 2500 Bytes.
A lower threshold has been chosen as the commit object size can be
bigger than the patch file without the diff, as there are at least
signatures inside the commit objects.
The last commit GNUtoo signed at the time of writing is the commit
83f955870a ("website/docs/build: mark
the Trisquel bug as solved and clarify the Guix one") and this is done
with an RSA GPG key of 4096 bits and in this case the signature is
about 855 bytes. This was calculated with 'git cat-file -p 83f95587'.
As GNU Boot is looking for contributions, including contributions by
less technical users, we do not require its use by people sending
patches, however it is still a good idea to require its use by the GNU
Boot maintainers as we want to spot the most important issues that
cannot be fixed later on.
Thanks to neox for the research and the calculation on the git commit
signature size.
Signed-off-by: Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
Acked-by: Adrien 'neox' Bourmault <neox@gnu.org>
This commit is contained in:
parent
9ed7e62253
commit
c6d776f2dc
GPG Key ID:
57BC26A3687116F6
|
|
@ -107,6 +107,7 @@ check:
|
|||
set -o pipefail ; ./tests/lint | tee -a $(LOG)
|
||||
set -o pipefail ; ./tests/distclean | tee -a $(LOG)
|
||||
set -o pipefail ; ./tests/targets 2>&1 | tee -a $(LOG)
|
||||
set -o pipefail ; ./tests/checkpatch 2>&1 | tee -a $(LOG)
|
||||
@echo "[ OK ] Makefile: $@ target. See $(LOG) for the log."
|
||||
|
||||
include resources/packages/i945-thinkpads-install-utilities/Makefile.am
|
||||
|
|
|
|||
|
|
@ -0,0 +1,622 @@
|
|||
#!/usr/bin/env -S guix repl --
|
||||
!#
|
||||
;; Copyright (C) 2024 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
(use-modules (ice-9 rdelim))
|
||||
(use-modules (ice-9 regex))
|
||||
(use-modules (srfi srfi-1))
|
||||
(use-modules (srfi srfi-9))
|
||||
(use-modules (srfi srfi-19))
|
||||
|
||||
(define (startswith str value)
|
||||
(if (> (string-length str) (string-length value))
|
||||
(string=? (substring str 0 (string-length value)) value) #f))
|
||||
|
||||
(define (read-file path func)
|
||||
(define results #f)
|
||||
(let ((port (open-input-file path)))
|
||||
(set! results (func path port))
|
||||
(close-port port)
|
||||
results))
|
||||
|
||||
(define (print-patch-name path)
|
||||
(define dashes
|
||||
(string-append
|
||||
(string-join (make-list (string-length path) "-") "")
|
||||
"\n"))
|
||||
(display dashes)
|
||||
(display (string-append path "\n"))
|
||||
(display dashes))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ;;
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;; ;;
|
||||
;; ;; Patch parsing logic ;; ;;
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;; ;;
|
||||
;; ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-record-type <rule>
|
||||
(make-rule name default line-match line end)
|
||||
rule?
|
||||
(name rule-name) ;; Name of the rule
|
||||
(default rule-default) ;; Runs once at the beginning, inconditionally
|
||||
(line-match rule-line-match) ;; Runs each line, returns true/false
|
||||
(line rule-line) ;; Runs if rule-line-match is true
|
||||
(end rule-end)) ;; Runs once at the end, inconditionally
|
||||
|
||||
(define parse-rules
|
||||
(list
|
||||
|
||||
;; Here's an example of a parse rule below. Since it runs each time it is
|
||||
;; also tested. TODO: A a proper unit testing environment needs to
|
||||
;; be added and then this could be moved to only run inside that
|
||||
;; separate testing environment.
|
||||
(make-rule
|
||||
"Example empty rule"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) #t)
|
||||
(lambda (line _ results) results)
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Count lines"
|
||||
(lambda (results) (acons 'line 0 results))
|
||||
(lambda (line _ results) #t)
|
||||
(lambda (line _ results)
|
||||
(acons 'line (+ 1 (assq-ref results 'line)) results))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Find diff start"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
(startswith line "diff --git "))
|
||||
(lambda (line _ results)
|
||||
(acons 'diff-start
|
||||
(assq-ref results
|
||||
'line) results))
|
||||
(lambda (path _ results)
|
||||
results))
|
||||
|
||||
(make-rule
|
||||
"Retrieve Signed-off-by"
|
||||
(lambda (results) (acons 'signed-off-by '() results))
|
||||
(lambda (line _ results) (startswith line "Signed-off-by: "))
|
||||
(lambda (line _ results)
|
||||
(let ((signed-off-by
|
||||
(string-join (cdr (string-split line #\ )) " ")))
|
||||
(acons 'signed-off-by
|
||||
(append (assq-ref results 'signed-off-by) (list signed-off-by))
|
||||
results)))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; TODO: Raise an exception if there is no lines with From:, and
|
||||
;; when handling it, complain that the file is not a valid git
|
||||
;; patch.
|
||||
(make-rule
|
||||
"Find commit author"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) (startswith line "From: "))
|
||||
(lambda (line _ results)
|
||||
(let ((commit-author (string-join (cdr (string-split line #\ )) " ")))
|
||||
(acons
|
||||
'commit-author
|
||||
commit-author
|
||||
results)))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Find commit hash"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
;; Example:
|
||||
;; From 0df4fe5fadfb7f51c1c34dad10ca9e6e04c3fa18 Mon Sep 17 00:00:00 2001
|
||||
(and (not (startswith line "From: "))
|
||||
(startswith line "From ")))
|
||||
(lambda (line _ results)
|
||||
(let ((commit-hash (list-ref (string-split line #\ ) 1)))
|
||||
(acons 'commit-hash commit-hash results)))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; TODO: Raise an exception if there is no lines with Date:, and
|
||||
;; when handling it, complain that the file is not a valid git
|
||||
;; patch.
|
||||
(make-rule
|
||||
"Find commit date"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) (startswith line "Date: "))
|
||||
(lambda (line _ results)
|
||||
(acons 'commit-date
|
||||
(string->date
|
||||
(string-join (cdr (string-split line #\ )) " ")
|
||||
"~a, ~d ~b ~Y ~H:~M:~S ~z")
|
||||
results))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; TODO:
|
||||
;; - In general we might want to have the commit summary instead of
|
||||
;; the subject, but for now we will use the mail subject instead
|
||||
;; as we don't use the summary yet and properly parsing the
|
||||
;; subject would require to reimplement the cleanup_subject
|
||||
;; function from mailinfo.c in git source code.
|
||||
;; - Raise an exception if there is no lines with From:, and when
|
||||
;; handling it, complain that the file is not a valid git patch.
|
||||
(make-rule
|
||||
"Find patch subject"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) (startswith line "Subject: "))
|
||||
(lambda (line _ results)
|
||||
(let ((commit-subject (string-join (cdr (string-split line #\ )) " ")))
|
||||
(acons
|
||||
'commit-subject-line
|
||||
(assq-ref results 'line)
|
||||
(acons
|
||||
'commit-subject
|
||||
commit-subject
|
||||
results))))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Find commit subject and message separator"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
;; TODO: Raise an exception if the line after the commit subject
|
||||
;; line is not empty, and when handling it, complain that the
|
||||
;; file is not a valid git patch.
|
||||
(and
|
||||
(not (assq-ref results 'commit-message-end-line))
|
||||
(assq-ref results 'commit-subject)
|
||||
(string=? line "")
|
||||
(eq? (+ 1 (assq-ref results 'commit-subject-line))
|
||||
(assq-ref results 'line))))
|
||||
(lambda (line _ results)
|
||||
(acons
|
||||
'commit-subject-message-separator-line
|
||||
(assq-ref results 'line)
|
||||
results))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; TODO: Raise an exception if there is more than two lines with
|
||||
;; ---, and when handling it, complain that the file is not a valid
|
||||
;; git patch.
|
||||
(make-rule
|
||||
"Find changelog end"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
(and
|
||||
(assq-ref results 'commit-message-end-line)
|
||||
(string=? line "---")))
|
||||
(lambda (line _ results)
|
||||
(acons 'changelog-end-line (assq-ref results 'line) results))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; TODO: Raise an exception if there is no line with ---, and when
|
||||
;; handling it, complain that the file is not a valid git patch.
|
||||
(make-rule
|
||||
"Find commit message end"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
;; This matches the first "---" but there could be more as shown
|
||||
;; in the example below:
|
||||
;; ---
|
||||
;; ChangeLog: [...]
|
||||
;; ---
|
||||
;; So until found we are in the commit message, but after it is found
|
||||
;; we could also be in the ChangeLog.
|
||||
(and (string=? line "---")
|
||||
(not (assq-ref results 'commit-message-end-line))))
|
||||
(lambda (line _ results)
|
||||
(acons 'commit-message-end-line (assq-ref results 'line) results))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Find the end of the commit"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) #f)
|
||||
(lambda (line _ results) results)
|
||||
(lambda (path _ results)
|
||||
(acons 'commit-end-line
|
||||
(if (assq-ref results 'changelog-end-line)
|
||||
(assq-ref results 'changelog-end-line)
|
||||
(assq-ref results 'commit-message-end-line))
|
||||
results)))
|
||||
|
||||
(make-rule
|
||||
"Find commit message"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results)
|
||||
(and
|
||||
(not (assq-ref results 'commit-message-end-line))
|
||||
(assq-ref results 'commit-subject-message-separator-line)
|
||||
(> (assq-ref results 'line)
|
||||
(assq-ref results 'commit-subject-message-separator-line))))
|
||||
(lambda (line _ results)
|
||||
(let ((commit-message
|
||||
(if (not (assq-ref results 'commit-message))
|
||||
(list)
|
||||
(append (assq-ref results 'commit-message) (list line)))))
|
||||
(acons
|
||||
'commit-message
|
||||
commit-message
|
||||
results)))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Find added files"
|
||||
(lambda (results)
|
||||
(acons 'added-files
|
||||
'() results))
|
||||
(lambda (line _ results)
|
||||
(and (startswith line " create mode ")))
|
||||
(lambda (line _ results)
|
||||
(define line-parts
|
||||
(string-split line #\space))
|
||||
(define added-file
|
||||
'())
|
||||
(if (> (length line-parts) 3)
|
||||
(set! added-file
|
||||
(list (list-ref line-parts 4))))
|
||||
(acons 'added-files
|
||||
(append (assq-ref results 'added-files) added-file)
|
||||
results))
|
||||
(lambda (path _ results)
|
||||
results))
|
||||
|
||||
(make-rule
|
||||
"Find deleted files"
|
||||
(lambda (results)
|
||||
(acons 'deleted-files
|
||||
'() results))
|
||||
(lambda (line _ results)
|
||||
(and (startswith line " delete mode ")))
|
||||
(lambda (line _ results)
|
||||
(define line-parts
|
||||
(string-split line #\space))
|
||||
(define deleted-file
|
||||
'())
|
||||
(if (> (length line-parts) 3)
|
||||
(set! deleted-file
|
||||
(list (list-ref line-parts 4))))
|
||||
(acons 'deleted-files
|
||||
(append (assq-ref results 'deleted-files) deleted-file)
|
||||
results))
|
||||
(lambda (path _ results)
|
||||
results))
|
||||
|
||||
(make-rule
|
||||
"Find modified files and track current file diff"
|
||||
(lambda (results)
|
||||
(acons 'current-diff-file #f
|
||||
(acons 'modified-files '() results)))
|
||||
(lambda (line _ results)
|
||||
(startswith line "diff --git a/"))
|
||||
(lambda (line _ results)
|
||||
(define line-parts
|
||||
(string-split line #\space))
|
||||
(define current-diff-file
|
||||
#f)
|
||||
(define modified-file
|
||||
'())
|
||||
(if (> (length line-parts) 3)
|
||||
;; Example: b/www/x60t_unbrick/0009.JPG
|
||||
(let* ((part3 (list-ref line-parts 3))
|
||||
;; remove the b/
|
||||
(path (substring part3 2
|
||||
(string-length part3))))
|
||||
(set! current-diff-file path)
|
||||
(if (not (or (any (lambda (added-file-path)
|
||||
(string=? added-file-path path))
|
||||
(assq-ref results 'added-files))
|
||||
(any (lambda (deleted-file-path)
|
||||
(string=? deleted-file-path
|
||||
path))
|
||||
(assq-ref results 'deleted-files))))
|
||||
(set! modified-file
|
||||
(list path)))))
|
||||
(acons 'modified-files
|
||||
(append (assq-ref results 'modified-files) modified-file)
|
||||
(acons 'current-diff-file current-diff-file
|
||||
results)))
|
||||
(lambda (path _ results)
|
||||
results))
|
||||
|
||||
(make-rule
|
||||
"Track diff"
|
||||
(lambda (results) results)
|
||||
(lambda (line _ results) #t)
|
||||
(lambda (line _ results)
|
||||
(define diff-start
|
||||
0)
|
||||
(define diff-end
|
||||
0)
|
||||
(if (and (assq-ref results
|
||||
'current-diff-file)
|
||||
(startswith line "@@"))
|
||||
(set! diff-start
|
||||
(assq-ref results
|
||||
'line)))
|
||||
(if (startswith line "diff --git a/")
|
||||
(set! diff-end
|
||||
(assq-ref results
|
||||
'line)))
|
||||
(if (and (not (eq? diff-start 0))
|
||||
(not (eq? diff-end 0)))
|
||||
(acons 'diff-end diff-end
|
||||
(acons 'diff-start diff-start results))
|
||||
(if (not (eq? diff-start 0))
|
||||
(acons 'diff-start diff-start results)
|
||||
(acons 'diff-end diff-end results))))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
(make-rule
|
||||
"Check for copyrights inside the patch"
|
||||
(lambda (results)
|
||||
(acons 'diff-path-added-proper-copyright
|
||||
'() results))
|
||||
(lambda (line _ results)
|
||||
(and (startswith line "+")
|
||||
(assq-ref results
|
||||
'current-diff-file)
|
||||
(> (assq-ref results
|
||||
'diff-start) 0)))
|
||||
(lambda (line _ results)
|
||||
(let ((diff-start (assq-ref results
|
||||
'diff-start))
|
||||
(diff-end (assq-ref results
|
||||
'diff-end))
|
||||
(current-diff-file (assq-ref results
|
||||
'current-diff-file))
|
||||
(commit-author (assq-ref results
|
||||
'commit-author))
|
||||
(commit-year (date-year (assq-ref results
|
||||
'commit-date))))
|
||||
;; Example: Copyright (C) 2024 Some Name <mail@domain.org>
|
||||
(if
|
||||
(string-match
|
||||
(string-append
|
||||
"Copyright[ ]\\(C\\)[ ]" ;"Copyright (C) "
|
||||
".*" ;We can have multiple years
|
||||
(number->string commit-year 10) ;Year
|
||||
".*" ;We can have multiple years
|
||||
" " ;We have at least 1 space before the author line
|
||||
commit-author) line)
|
||||
(acons 'diff-path-added-proper-copyright
|
||||
(append (assq-ref results
|
||||
'diff-path-added-proper-copyright)
|
||||
(list current-diff-file)) results)
|
||||
results)))
|
||||
(lambda (path _ results) results))
|
||||
|
||||
;; We can also use rules for debugging the code, here are two
|
||||
;; examples below.
|
||||
|
||||
;; (make-rule
|
||||
;; "Debug: print lines."
|
||||
;; (lambda (results) results)
|
||||
;; (lambda (line _ results) #t)
|
||||
;; (lambda (line _ results)
|
||||
;; (display "Count lines: line #")
|
||||
;; (display (+ 1 (assq-ref results 'line)))
|
||||
;; (display (string-append ": " line "\n"))
|
||||
;; results)
|
||||
;; (lambda (path _ results) results))
|
||||
|
||||
;; (make-rule
|
||||
;; "Debug: print results."
|
||||
;; (lambda (results) results)
|
||||
;; (lambda (line _ results) #f)
|
||||
;; (lambda (line _ results) results)
|
||||
;; (lambda (path _ results)
|
||||
;; (pk results)
|
||||
;; results))
|
||||
))
|
||||
|
||||
(define (set-defaults rules results)
|
||||
(for-each
|
||||
(lambda (rule)
|
||||
(set! results ((rule-default rule) results)))
|
||||
rules)
|
||||
results)
|
||||
|
||||
(define (run-line-match-rules port rules parse-results results)
|
||||
(define line (read-line port))
|
||||
(if (eof-object? line)
|
||||
results
|
||||
((lambda _
|
||||
(for-each
|
||||
(lambda (rule)
|
||||
(if ((rule-line-match rule) line parse-results results)
|
||||
(set! results ((rule-line rule) line parse-results results))))
|
||||
rules)
|
||||
(run-line-match-rules port rules parse-results results)))))
|
||||
|
||||
(define (run-end-rules path rules other-results results)
|
||||
(for-each
|
||||
(lambda (rule)
|
||||
(set! results ((rule-end rule) path other-results results)))
|
||||
rules)
|
||||
results)
|
||||
|
||||
(define (run-parse-rules rules path)
|
||||
(read-file
|
||||
path
|
||||
(lambda (path port)
|
||||
(let* ((defaults (set-defaults rules '()))
|
||||
(results (run-line-match-rules port rules #f defaults)))
|
||||
(run-end-rules path rules #f results)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ;;
|
||||
;; ;;;;;;;;;;;; ;;
|
||||
;; ;; Checks ;; ;;
|
||||
;; ;;;;;;;;;;;; ;;
|
||||
;; ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (run-check-rules parse-results rules path)
|
||||
(read-file
|
||||
path
|
||||
(lambda (path port)
|
||||
(let* ((defaults (set-defaults rules '()))
|
||||
(check-results
|
||||
(run-line-match-rules port rules parse-results defaults)))
|
||||
(run-end-rules path rules parse-results check-results)))))
|
||||
|
||||
(define check-rules
|
||||
(list
|
||||
|
||||
;; Here's an example of a check rule below. Since it runs each time it is
|
||||
;; also tested. TODO: A a proper unit testing environment needs to
|
||||
;; be added and then this could be moved to only run inside that
|
||||
;; separate testing environment.
|
||||
(make-rule
|
||||
"Example empty rule"
|
||||
(lambda (check-results) check-results)
|
||||
(lambda (line parse-results check-results) #t)
|
||||
(lambda (line parse-results check-results) check-results)
|
||||
(lambda (path parse-results check-results) check-results))
|
||||
|
||||
(make-rule
|
||||
"Count lines"
|
||||
(lambda (check-results) (acons 'line 0 check-results))
|
||||
(lambda (line parse-results check-results) #t)
|
||||
(lambda (line parse-results check-results)
|
||||
(acons 'line (+ 1 (assq-ref check-results 'line)) check-results))
|
||||
(lambda (path parse-results check-results) check-results))
|
||||
|
||||
;; Workarround for the bug #66268
|
||||
;; [1]https://debbugs.gnu.org/cgi/bugreport.cgi?bug=66268
|
||||
(make-rule
|
||||
"Enforce commit size < 4KB"
|
||||
(lambda (check-results)
|
||||
(acons 'commit-size 0 check-results))
|
||||
(lambda (line parse-results check-results)
|
||||
(< (assq-ref check-results 'line)
|
||||
(assq-ref parse-results 'commit-end-line)))
|
||||
(lambda (line parse-results check-results)
|
||||
(acons 'commit-size
|
||||
(+
|
||||
1 ;; for the \n
|
||||
(string-length line)
|
||||
(assq-ref check-results 'commit-size))
|
||||
check-results))
|
||||
(lambda (path parse-results check-results)
|
||||
;; We're not sure of the exact size limit so let's use 2500
|
||||
;; instead of 4096, since we're not counting signatures etc
|
||||
(let ((limit 2500)
|
||||
(commit-size (assq-ref check-results 'commit-size)))
|
||||
(if (>= commit-size limit)
|
||||
((lambda _
|
||||
(display
|
||||
(string-append
|
||||
"ERROR: Commit size is " (number->string commit-size) " B"
|
||||
" which is over the " (number->string limit) " B limit\n\n"))
|
||||
(acons
|
||||
'errors
|
||||
(+ 1 (assq-ref check-results 'errors)) check-results)))
|
||||
check-results))))
|
||||
|
||||
(make-rule
|
||||
"Check for Signed-off-by"
|
||||
(lambda (check-results) check-results)
|
||||
(lambda (line parse-results check-results) #t)
|
||||
(lambda (line parse-results check-results) check-results)
|
||||
(lambda (path parse-results check-results)
|
||||
(let ((author (assq-ref parse-results 'commit-author)))
|
||||
(if (not (any (lambda (elm)
|
||||
(string=? author elm))
|
||||
(assq-ref parse-results 'signed-off-by)))
|
||||
((lambda _
|
||||
(display
|
||||
(string-append "ERROR: Missing Signed-off-by: " author "\n\n"))
|
||||
(acons
|
||||
'errors
|
||||
(+ 1 (assq-ref check-results 'errors)) check-results)))
|
||||
check-results))))
|
||||
|
||||
(make-rule
|
||||
"Track total errors and warnings"
|
||||
(lambda (check-results) (acons 'warnings 0 (acons 'errors 0 check-results)))
|
||||
(lambda (line parse-results check-results) #t)
|
||||
(lambda (line parse-results check-results) check-results)
|
||||
(lambda (path parse-results check-results)
|
||||
(let* ((nr-lines (number->string (assq-ref parse-results 'line) 10))
|
||||
(errors (assq-ref check-results 'errors))
|
||||
(warnings (assq-ref check-results 'warnings))
|
||||
(error-text
|
||||
(string-append (number->string errors 10)
|
||||
(if (> errors 1) " errors, " " error, ")))
|
||||
(warning-text
|
||||
(string-append (number->string warnings 10)
|
||||
(if (> warnings 1) " warnings, " " warning, "))))
|
||||
(display
|
||||
(string-append
|
||||
"total: " error-text warning-text nr-lines " lines checked\n\n"))
|
||||
(if (or (> errors 0) (> warnings 0))
|
||||
((lambda _
|
||||
(display
|
||||
(string-append path " has style problems, please review.\n"))
|
||||
(display
|
||||
(string-append
|
||||
"NOTE: If any of the errors are false positives, "
|
||||
"please report them to the GNU Boot maintainers.\n"))))
|
||||
(display
|
||||
(string-append
|
||||
path
|
||||
" has no obvious style problems "
|
||||
"and is ready for submission.\n"))))
|
||||
check-results))))
|
||||
|
||||
(define (test-patch path)
|
||||
(let* ((parse-results (run-parse-rules parse-rules path))
|
||||
(check-results (run-check-rules parse-results check-rules path)))
|
||||
parse-results))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ;;
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
|
||||
;; ;; Command line parsing handlig ;; ;;
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
|
||||
;; ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; error if not in git tree and in topdir.
|
||||
(define (in-tree-topdir?)
|
||||
(string=?
|
||||
(canonicalize-path (getcwd))
|
||||
(dirname (dirname (current-filename)))))
|
||||
|
||||
(define (usage progname exit-code)
|
||||
(display (string-append
|
||||
"Usage: "
|
||||
progname
|
||||
" [path/to/file.patch [path/to/file.patch ...]]\n"))
|
||||
(exit exit-code))
|
||||
|
||||
(if (eq? (length (program-arguments)) 1)
|
||||
(usage "checkpatch.pl" 64) ;; 64 is EX_USAGE in sysexits.h
|
||||
(if (not (in-tree-topdir?))
|
||||
((lambda _
|
||||
(display
|
||||
(string-append
|
||||
"Error: please run checkpatch.scm in the git top directory.\n"))
|
||||
(exit 69))) ;; 69 is EX_UNAVAILABLE in sysexits.h
|
||||
(map (lambda (path)
|
||||
(if (> (length (program-arguments)) 2)
|
||||
(print-patch-name path))
|
||||
(test-patch path))
|
||||
(cdr (program-arguments)))))
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
#!/usr/bin/env bash
|
||||
#
|
||||
# Copyright (C) 2023,2024 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
|
||||
#
|
||||
# This program is free software: you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
fail()
|
||||
{
|
||||
message="$1"
|
||||
|
||||
printf "[ !! ] scripts/checkpatch.scm test failed: %s\n" \
|
||||
"${message}"
|
||||
}
|
||||
|
||||
printf "+--------------------------------------+\n"
|
||||
printf "| Running scripts/checkpatch.scm test: |\n"
|
||||
printf "+--------------------------------------+\n"
|
||||
|
||||
topdir="$(dirname "$(dirname "$(realpath "$0")")")"
|
||||
tmpdir="$(mktemp -d)"
|
||||
|
||||
test -f "${topdir}"/scripts/checkpatch.scm || fail "checkpatch.scm not found."
|
||||
test -f "${topdir}"/resources/git/git || fail "resources/git/git not found."
|
||||
|
||||
patches="$("${topdir}"/resources/git/git format-patch --root -o "${tmpdir}")"
|
||||
# shellcheck disable=SC2086
|
||||
|
||||
"${topdir}"/scripts/checkpatch.scm ${patches}
|
||||
|
||||
rm -rf "${tmpdir}"
|
||||
|
||||
printf "+---------------------+\n"
|
||||
printf "| Running tests done: |\n"
|
||||
printf "+---------------------+\n"
|
||||
|
|
@ -66,6 +66,7 @@ run_shellcheck \
|
|||
resources/packages/website/distclean \
|
||||
resources/scripts/misc/guix.sh \
|
||||
resources/scripts/tasks/distclean.sh \
|
||||
tests/checkpatch \
|
||||
tests/distclean \
|
||||
tests/lint \
|
||||
website/build.sh \
|
||||
|
|
|
|||
|
|
@ -217,6 +217,37 @@ maintainers agree to merge the patches but need to wait for the
|
|||
approval of the GNU project for instance if there are legal questions
|
||||
that also require the approval of the GNU Project.
|
||||
|
||||
Testing for common issues in patches
|
||||
------------------------------------
|
||||
|
||||
Once you built GNU Boot images or the GNU Boot website, it is possible
|
||||
to run various automatic tests. You can run them with the following
|
||||
command:
|
||||
```
|
||||
make check
|
||||
```
|
||||
either in the website directory (if you want to test the website) or
|
||||
in the top directory (if you want to test the rest).
|
||||
|
||||
We also have a script that can test your patch for common issues we
|
||||
identified. It can be used in this way (with 0001-fix-bug-#1234.patch
|
||||
being the patch you are about to send):
|
||||
|
||||
```
|
||||
$ guile ./scripts/checkpatch.scm ./0001-fix-bug-#1234.patch
|
||||
[...]
|
||||
total: 0 error, 0 warning, 88 lines checked
|
||||
|
||||
./0001-fix-bug-#1234.patch has no obvious style problems and is ready for submission.
|
||||
```
|
||||
|
||||
While running all these tests is not mandatory (unless you are a GNU
|
||||
Boot maintainer), it can still be helpful and save time for everybody
|
||||
as it can spot issues before sending patches to the mailing lists,
|
||||
and this will let you fix the issue faster than waiting for other
|
||||
people to run tests and asking you to fix your patch and resend it
|
||||
once it is fixed.
|
||||
|
||||
Maintainers
|
||||
-----------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue