(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *possible-states*
- '(:begin ; start of file
+ '(:copyright-required
+ :begin ; start of file
:normal ; normal processing
:beginning-of-line
:beginning-of-line-with-separator ; empty space in there
(setf *state* state)
nil)
+(defun make-evaluator (eval-state match func)
+ (let
+ ((scanner (when (stringp match) (cl-ppcre:create-scanner match))))
+ (list
+ (lambda (state text)
+ (and
+ (or (eql :all eval-state) (eql eval-state state))
+ (or
+ (and (symbolp text) (eql text match))
+ (and
+ scanner
+ (stringp text)
+ (multiple-value-bind (start end) (cl-ppcre:scan scanner text)
+ (and start end (= 0 start)))))))
+ (lambda (text) (nth-value 1 (cl-ppcre:scan scanner text)))
+ func)))
+
(defmacro defevaluator (state match func)
(when (not (find state *possible-states*)) (error "~A is an invalid state" state))
(let
((scanner (gensym)))
- `(let
- ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match))))
- (pushnew
- (list
- (lambda (state text)
- (and
- (or (eql :all ,state) (eql ,state state))
- (or
- (and (symbolp text) (eql text ,match))
- (and
- ,scanner
- (stringp text)
- (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text)
- (and start end (= 0 start)))))))
- (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text))))
- ,func)
- *evaluators*))))
+ `(pushnew (make-evaluator ,state ,match ,func) *evaluators*)))
(defun evaluate (text)
(if (string= "" text)
(error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))
(let
((length-of-match (funcall (cadr evaluator) text)))
- (incf *col-no* length-of-match)
+ (if
+ (eql *col-no* :reset)
+ (setf *col-no* 0)
+ (incf *col-no* length-of-match))
(when (< 120 *col-no*)
(error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0)))
(evaluate (subseq text length-of-match)))))))
(with-open-file (str filename :element-type element-type)
(let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
-(defun check-file (file)
- "CHECK-FILE FILE => RESULT
+(defun check-file (file &key copyright-notice)
+ (cond
+ (copyright-notice (set-state :copyright-required))
+ ((string= "package" (pathname-name file)) (set-state :normal))
+ (t (set-state :begin)))
+ (setf *line-no* 0)
+ (setf *col-no* 0)
+ (setf *form-stack* nil)
+ (setf *form-ended-on-same-line* nil)
+ (when copyright-notice
+ (setf *evaluators*
+ (append *evaluators*
+ (list
+ (make-evaluator :copyright-required (format nil "~A\\n" copyright-notice)
+ (lambda ()
+ (incf *line-no*)
+ (setf *col-no* :reset)
+ (if (string= "package" (pathname-name file))
+ (set-state :normal)
+ (set-state :begin))))))))
+ (handler-case
+ (progn
+ (evaluate (slurp-file file))
+ (list :success file))
+ (check-failure (cf)
+ (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf)))))
+
+(setf (documentation 'check-file 'function)
+ "CHECK-FILE FILE &key COPYRIGHT-NOTICE => RESULT
RESULT: SUCCESS-RESULT | FAILURE-RESULT
SUCCESS-RESULT: (:success FILENAME)
ARGUMENTS AND VALUES:
FILE: a pathname
+ COPYRIGHT-NOTICE: A regex string
FILENAME: the file this check was run on
MSG: a string containing the failure message
LINE-NO: an integer, the line number on which the failure appeared
CHECK-FILE runs all the checks against a file and returns
as soon as the first style error is found.
+ If COPYRIGHT-NOTICE is included, then the first line must match the
+ regular expression passed.
+
EXAMPLES:
(check-file #P\"path/to/file.lisp\") => (:success \"path/to/file.lisp\")
- (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0)"
+ (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0)
+ (check-file #P\"path/to/error.lisp\" :copyright-notice \"; Copyright .* AGPL\") => (:failure ...)")
- (if (string= "package" (pathname-name file))
- (set-state :normal)
- (set-state :begin))
- (setf *line-no* 0)
- (setf *col-no* 0)
- (setf *form-stack* nil)
- (setf *form-ended-on-same-line* nil)
- (handler-case
- (progn
- (evaluate (slurp-file file))
- (list :success file))
- (check-failure (cf)
- (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf)))))
-
-(defun check-directory (dir)
- "CHECK-DIRECTORY DIR => RESULTS
+(defun check-directory (dir &key copyright-notice)
+ "CHECK-DIRECTORY DIR &key COPYRIGHT-NOTICE => RESULTS
RESULTS: RESULT*
ARGUMENTS AND VALUES:
DIR: A directory to recurse into and check files
+ COPYRIGHT-NOTICE: A regex string
RESULT: A result as returned by check-file
DESCRIPTION:
CHECK-DIRECTORY grabs all .lisp files in the tree under DIR, and loads
checks them all.
+ If COPYRIGHT-NOTICE is included, then the first line must match the
+ regular expression passed.
+
The results are then put together into a list which can be programatically
evaluated. As opposed to pretty-print-check-directory, this function doesn't
clutter up your standard out."
- (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir))))
+ (mapcar
+ (lambda (file) (check-file file :copyright-notice copyright-notice))
+ (directory (format nil "~A/**/*.lisp" dir))))
(defun any-failures (checks)
(find :failure checks :key #'car))
(with-open-file (str (second failure)) (loop :repeat (fourth failure) :do (read-line str)) (read-line str))
(+ (fifth failure) 2)))
-(defun pretty-print-check-directory (dir)
- "PRETTY-PRINT-CHECK-DIRECTORY DIR => SUCCESS
+(defun pretty-print-check-directory (dir &key copyright-notice)
+ "PRETTY-PRINT-CHECK-DIRECTORY DIR &key COPYRIGHT-NOTICE => SUCCESS
ARGUMENTS AND VALUES:
DIR: A directory to recurse into and check files
+ COPYRIGHT-NOTICE: A regex string
SUCCESS: T if there were no failures
DESCRIPTION:
PRETTY-PRINT-CHECK-DIRECTORY checks DIR for any errors, dumping them to output
and returning a single flag.
+ If COPYRIGHT-NOTICE is included, then the first line must match the
+ regular expression passed.
+
Unlike check-directory, PRETTY-PRINT-CHECK-DIRECTORY is built for continuous
integration, dumping errors to standard out and returning a singular result.
(pretty-print-check-directory \"src\") => nil"
(let
- ((checks (check-directory dir)))
+ ((checks (check-directory dir :copyright-notice copyright-notice)))
(format t "In ~A: Checked ~A files with ~A failures~%~%"
dir (length checks) (length (remove :success checks :key #'car)))
(format t "~{~A~%~}" (mapcar #'print-failure (remove :success checks :key #'car)))
(defevaluator :all "\\t" (constantly "Must not use tabs"))
(defevaluator :begin "\\(in-package[^\\)]*\\)" (lambda () (set-state :normal)))
+(defevaluator :copyright-required "\\(in-package[^\\)]*\\)" (constantly "Must begin with specified copyright notice"))
(defevaluator :beginning-of-line-with-separator :eof
(lambda ()
(defevaluator :beginning-of-line-with-separator "\\n" (constantly "Must not have two empty lines in a row"))
+(defevaluator :copyright-required ".*" (constantly "Must begin with specified copyright notice"))
+
(defevaluator :begin ".*" (constantly "Must begin with in-package form"))
(defevaluator :all "\\( *in-package " (constantly "Only one in-package per file"))
(defevaluator :normal "\\n"
(lambda ()
(incf *line-no*)
- (setf *col-no* -1)
+ (setf *col-no* :reset)
(set-state :beginning-of-line)))
(defevaluator :comment-with-separator "\\n"
(lambda ()
(incf *line-no*)
- (setf *col-no* -1)
+ (setf *col-no* :reset)
(set-state :beginning-of-line-with-comment-and-separator)
nil))
(lambda ()
(progn
(incf *line-no*)
- (setf *col-no* -1)
+ (setf *col-no* :reset)
(set-state :beginning-of-line-with-separator))))
(defevaluator :beginning-of-line-with-comment-and-separator " *"
"No whitespace only lines"
(progn
(incf *line-no*)
- (setf *col-no* -1)
+ (setf *col-no* :reset)
(set-state :beginning-of-line-with-separator)))))
(defevaluator :beginning-of-symbols "\\)" (constantly "No hanging close parens"))
(defevaluator :in-string "\\n"
(lambda ()
(incf *line-no*)
- (setf *col-no* -1)
+ (setf *col-no* :reset)
nil))
(defevaluator :in-string "." (constantly nil))
projects / wolf / blobdiff