On Mon, 10 Mar 2025 11:37:29 +0100 Simon Tournier <zimon.touto...@gmail.com> wrote: > Yes, this can be fixed with tooling. But that’s the wrong frame for > an answer, IMHO. The question is: who commits in maintaining such > tools? This is a good point. One possibility is that someone write tools and that they are collectively improved step by step by people who use them, like with checkpatch.pl, but that might not always work as I'm unsure how to predict how much work a tool would need.
I've no idea if this is relevant or not here but I wrote a tool to check patches like checkpatch.pl for GNU Boot that I attached and note that it has a lot of limitations: - It's made by someone that barely know scheme (me) and that learned about SICP and such design just before writing this code, and I still have a lot to learn, it has code duplication and so on. - Its error handling is not great, but it also comes with some test coverage as I run it on almost all the patches that makes the GNU Boot history, and it has a few specific tests as well. - It tests very few things as it's still extremely new. - The worst part is probably that it's very specific to GNU Boot, and that it's not configurable yet. checkpatch.pl is configurable and while it's maintained within the Linux git, it is also imported in a wide variety of C projects (from u-boot, to anyone who wants to use it, I even used it for a library that I maintained) and for that it needs to be configurable to at least avoid some linux-specific tests. The tool I wrote could easily be adapted to check if a given patch set applies, but I also wonder how relevant such tools is because I've no idea where it should run in the case of Guix, or if rewriting it from scratch for that case make more sense. Your setup is quite optimized and so would you (or anybody else that do review patches) expect code that detects badly formatted patches or patches that don't apply to run on your local machines in a shell?, inside emacs?, inside the QA system (and tag the bug report / patch)?, or in multiple environments? or in all these contexts? Denis.
#!/usr/bin/env -S guix repl -- !# ;; Copyright (C) 2024 Denis 'GNUtoo' Carikli <gnu...@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 popen)) (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)) (define (file-exists-at-commit? commit path) (not (eof-object? (let* ((port (open-pipe* OPEN_READ "git" "ls-tree" commit "--" path)) (str (read-line port))) str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; 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 (path _ results) results) (lambda (line _ results) #t) (lambda (line _ results) results) (lambda (path _ results) results)) (make-rule "Count lines" (lambda (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ results) results) (lambda (line _ results) ;; Example: ;; From 0df4fe5fadfb7f51c1c34dad10ca9e6e04c3fa18 Mon Sep 17 00:00:00 2001 (and (not (startswith line "From: ")) (startswith line "From ") ;; We only want to match the first result, otherwise a 'From [...] ;; within the commit message will match. (not (assq-ref results 'commit-hash)))) (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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 (path _ 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 <m...@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 (path _ 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 (path _ results) results) ;; (lambda (line _ results) #f) ;; (lambda (line _ results) results) ;; (lambda (path _ results) ;; (pk results) ;; results)) )) (define (set-defaults rules path parse-results results) (for-each (lambda (rule) (set! results ((rule-default rule) path parse-results 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 path #f '())) (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 path parse-results '())) (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 (path parse-results 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 "Check if the patch commit hash is in git" (lambda (path parse-results check-results) (define commit-hash (assq-ref parse-results 'commit-hash)) (define void-port (%make-void-port OPEN_WRITE)) (define (return value) (close void-port) value) (define (commit-hash-in-git? hash) ;; The documentation (man 7 gitrevisions) shows that the ;; format is not very strict, so we can't ever pass a revision ;; to a shell. So (1) we check everything, and (2) we use ;; functions that run programs without using a shell. Note ;; that it's still possible to bypass the check by using a ;; maliciously crafted revision like 'HEAD', however here we ;; rely on the good faith of contributors and they are even ;; encouraged to run checkpatch.scm themselves. (cond ((not (= EXIT_SUCCESS (with-output-to-port void-port (lambda _ (system* "git" "--no-pager" "rev-parse" "-q" "--verify" hash))))) (return #f)) ;; Then we check if the hash is in the current git repository. ((= EXIT_SUCCESS (with-output-to-port void-port (lambda _ (system* "git" "--no-pager" "rev-list" "--quiet" "-1" hash)))) (return #t)) (else (return #f)))) (cond ((not commit-hash) (display "Error: the patch has no commit hash.\n") (exit 69)) ;; 69 is EX_UNAVAILABLE in sysexits.h ((not (commit-hash-in-git? commit-hash)) (display (string-append "Error: the patch commit hash (" commit-hash ") is not\n" " in git. To fix it, you need to import the patche(s) " "with the following\n" " command:\n" " git am " path "\n" " However if this patch depends on other patches, " "you will also need to\n" " import them before with git am as well.\n")) (exit 69)) ;; 69 is EX_UNAVAILABLE in sysexits.h (else 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 (path parse-results 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)) (make-rule "Track current file diff" (lambda (path parse-results check-results) (acons 'current-diff-file #f check-results)) (lambda (line parse-results check-results) (startswith line "diff --git a/")) (lambda (line parse-results check-results) (define line-parts (string-split line #\space)) (define current-diff-file #f) (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))) (acons 'current-diff-file current-diff-file check-results)) (lambda (path _ 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 (path parse-results 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 (path parse-results 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 "Warn about missing translations" (lambda (path parse-results 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) (define warnings (assq-ref check-results 'warnings)) (define (english-page? path) (and (not (string-match "website/pages/.*\\.es\\.md" path)) (string-match "website/pages/.*\\.md" path))) (define (english-page->spanish-page path) (regexp-substitute #f (string-match "\\.md$" path) 'pre ".es.md")) (define (spanish-needs-update? page-path) (cond ((not (english-page? page-path)) #f) ;; We cannot expects contributors to ever update Spanish ;; pages if they do not exit. ((not (file-exists-at-commit? (assq-ref parse-results 'commit-hash) (english-page->spanish-page page-path))) #f) ;; This checks if the patch updates the corresponding ;; Spanish file. If it doesn't the file needs update ;; and a warning is added. ((not (= 1 (length (filter (lambda (modified-file-path) (string=? modified-file-path (english-page->spanish-page page-path))) (assq-ref parse-results 'modified-files))))) #t) (else #f))) (for-each (lambda (current-page) (if (spanish-needs-update? current-page) ((lambda _ (set! warnings (+ 1 warnings)) (display (string-append "WARNING: " current-page " was updated but not " (english-page->spanish-page current-page) ".\n\n")))))) (assq-ref parse-results 'modified-files)) (acons 'warnings warnings check-results))) (make-rule "Check @node alignement in the manual" (lambda (path parse-results check-results) (acons 'current-node #f check-results)) (lambda (line parse-results check-results) (and (assq-ref check-results 'current-diff-file) (string=? (assq-ref check-results 'current-diff-file) "manual/gnuboot.texi"))) (lambda (line parse-results check-results) (define warnings (assq-ref check-results 'warnings)) (define* (node-name line prefix type) (regexp-substitute #f (string-match (string-append "\\" prefix "@" type " +") line) 'post)) (define (handle-node-type prefix type warnings) (define current-node-name (substring (assq-ref check-results 'current-node) 1 (string-length (assq-ref check-results 'current-node)))) (lambda (line parse-results check-results) (if (and (string=? (node-name line prefix type) (node-name (string-append prefix current-node-name) prefix "node")) (not (= (string-length (substring line (string-length prefix) (string-length line))) (string-length current-node-name)))) ((lambda _ (display (string-append "WARNING: " (node-name line prefix type) " " type " and node are not aligned.\n\n")) (+ 1 warnings))) warnings))) ;; We have at least 3 cases we want to detect: ;; - a @chapter/@*section was changed and node was not ;; - a @chapter/@*section was not changed and node was ;; - both were changed ;; So we store the @node reguardless of if it was changed or ;; not, and then we also look at @chapter/@*section reguardless ;; of the change of both node or @chapter/@*section. ;; To avoid trigering when none changed, we store the full line ;; with @node, including the begining "+" or " ", to then be ;; able to know that node didn't change in the @chapter/@*section. (cond ((or (startswith line "+@node ") (startswith line " @node ")) (acons 'current-node (substring line 0 (string-length line)) check-results)) ;; Skip when nothing changed. Note that (assq-ref check-results ;; 'current-node) is sometime false. So we cannot assume it is ;; a string unless we check if it is not false before. ((and (assq-ref check-results 'current-node) (startswith line " @chapter ") (startswith (assq-ref check-results 'current-node) " @node ")) check-results) ((and (assq-ref check-results 'current-node) (or (startswith line "+@chapter ") (startswith line " @chapter "))) (acons 'warnings ((handle-node-type (substring line 0 1) ;; "+" or " " "chapter" warnings) line parse-results check-results) check-results)) ;; Skip when nothing changed. Note that (assq-ref check-results ;; 'current-node) is sometime false. So we cannot assume it is ;; a string unless we check if it is not false before. ((and (assq-ref check-results 'current-node) (startswith line " @section ") (startswith (assq-ref check-results 'current-node) " @node ")) check-results) ((and (assq-ref check-results 'current-node) (or (startswith line "+@section ") (startswith line " @section "))) (acons 'warnings ((handle-node-type (substring line 0 1) ;; "+" or " " "section" warnings) line parse-results check-results) check-results)) ;; Skip when nothing changed. Note that (assq-ref check-results ;; 'current-node) is sometime false. So we cannot assume it is ;; a string unless we check if it is not false before. ((and (assq-ref check-results 'current-node) (startswith line " @subsection ") (startswith (assq-ref check-results 'current-node) " @node ")) check-results) ((and (assq-ref check-results 'current-node) (or (startswith line "+@subsection ") (startswith line " @subsection "))) (acons 'warnings ((handle-node-type (substring line 0 1) ;; "+" or " " "subsection" warnings) line parse-results check-results) check-results)) ;; Skip when nothing changed. Note that (assq-ref check-results ;; 'current-node) is sometime false. So we cannot assume it is ;; a string unless we check if it is not false before. ((and (assq-ref check-results 'current-node) (startswith line " @subsubsection ") (startswith (assq-ref check-results 'current-node) " @node ")) check-results) ((and (assq-ref check-results 'current-node) (or (startswith line "+@subsubsection ") (startswith line " @subsubsection "))) (acons 'warnings ((handle-node-type (substring line 0 1) ;; "+" or " " "subsubsection" warnings) line parse-results check-results) check-results)) (else check-results))) (lambda (path parse-results check-results) check-results)) (make-rule "Track total errors and warnings" (lambda (path parse-results 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 (in-git-dir?) (file-exists? ".git/config")) (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 (cond ((or (not (in-tree-topdir?)) (not (in-git-dir?))) ((lambda _ (display (string-append "Error: please run checkpatch.scm in the git top directory.\n")) (exit 69)))) ;; 69 is EX_UNAVAILABLE in sysexits.h (else (map (lambda (path) (if (> (length (program-arguments)) 2) (print-patch-name path)) (test-patch path)) (cdr (program-arguments))))))
pgpTTITJmVaNv.pgp
Description: OpenPGP digital signature
